      OVERLAY (LINK,0,0)                                                       1
      PROGRAM CONTOUR(INPUT,OUTPUT,TAPE5=INPUT,TAPE6=OUTPUT,TAPE7,TAPE8,       2
     1TAPE9)                                                                   3
      INTEGER FRMT                                                             4
      DIMENSION FRMT(8)                                                        5
      DIMENSION            KORE(4),KORN(4)                                     6
      REAL          MINWRD2,MAXWRD2,MINWRD3,MAXWRD3                            7
      COMMON /BLK2/ KORE,KORN,IFYP,SCLE                                        8
      COMMON /BLK3/ KM,LM                                                      9
      COMMON /BLK4/ DIST,TANG,M                                               10
      COMMON /BLK5/ MINWRD2,MAXWRD2,MINWRD3,MAXWRD3                           11
      COMMON /BLK6/ SP,SPP,LAST,DISPGRD, LINEUNT                              12
      COMMON /BLK7/ N,NN,PX1,PY1,XMAX,YMAX,XMAY,YMAY,CI                       13
      COMMON/BLK14/ UNIT,CNVTOIN                                              14
      COMMON /BLK15/ IRDTP,IPTOPT,ISRTOPT                                     15
      COMMON /BLK30/ ISRT                                                     16
      COMMON /BLK40/ KMAX,KMAX1,IDMX                                          17
      COMMON /LIMITS/ MINI,MAXI,IADDI                                         18
      COMMON /LINKDC/ LINK,RECALL                                             19
      RECALL=6LRECALL                                                         20
      LINK=4LLINK                                                             21
    3 FORMAT(8A10)                                                            22
      READ (5,3) FRMT                                                         23
      READ(5,2) KMAX,KMAX1,IDMX                                               24
    2 FORMAT (2I4,I10)                                                        25
      READ (5,FRMT) DIST,UNIT,CNVTOIN ,SPP,CI,SCLE,DISPGRD                    26
     1,TANG                                                                   27
      READ (5,4) ISRT,MINI,MAXI                                               28
    4 FORMAT(I4,2I10)                                                         29
      LINEUNT=DISPGRD                                                         30
      IFYP=1$LAST=2                                                           31
      READ (5,1) IRDTP,IPTOPT,ISRTOPT                                         32
    1 FORMAT(3I4)                                                             33
      CALL OVERLAY(LINK,1,0,RECALL)                                           34
      IF (ISRT.EQ.1) CALL OVERLAY(LINK,2,0,RECALL)                            35
      CALL OVERLAY(LINK,3,0,RECALL)                                           36
      STOP                                                                    37
      END                                                                     38
      OVERLAY (LINK,1,0)                                                      39
      PROGRAM READIT                                                          40
      INTEGER FRMT                                                            41
      DIMENSION FRMT(8)                                                       42
      DIMENSION            KORE(4),KORN(4),WRD(3,4)                           43
      REAL MAXWRD2,MINWRD2,MAXWRD3,MINWRD3                                    44
      COMMON /BLK2/ KORE,KORN,IFYP,SCLE                                       45
      COMMON /BLK4/ DIST                                                      46
      COMMON /BLK5/ MINWRD2,MAXWRD2,MINWRD3,MAXWRD3                           47
      COMMON /BLK15/ IRDTP,IPTOPT,ISRTOPT                                     48
      COMMON /BLK30/ ISRT                                                     49
      COMMON /LIMITS/ MINI,MAXI,IADDI                                         50
      COMMON /LINKDC/ LINK,RECALL                                             51
    1 FORMAT (8A10)                                                           52
      REWIND 7                                                                53
      ALPHA=(-11.8/180.0)*(3.141592654)                                       54
      ICNT=0                                                                  55
      ICODE=0                                                                 56
      IF(IRDTP.NE.1) READ(5,1) FRMT                                           57
  100 CONTINUE                                                                58
      IF (IRDTP.EQ.1) GO TO 1000                                              59
      IF (IPTOPT.GE.1) READ(5,FRMT) IX,IY,IZ                                  60
      IF (IPTOPT.LT.1) READ(5,FRMT) X,Y,Z                                     61
      IF (EOF(5))  1002,1001                                                  62
 1000 IF (IPTOPT.GE.1) CALL RECIN (9,1,KK,IX,IY,IZ)                           63
      IF (IPTOPT.LT.1) CALL RECIN (9,1,KK,X,Y,Z)                              64
      IF (EOF(9))1002,1001                                                    65
 1001 CONTINUE                                                                66
      IF (MINI.EQ.0.AND.MAXI.EQ.0) 104,105                                    67
  105 CONTINUE                                                                68
      IF ( Z.LT.MINI.OR. Z.GT.MAXI) 100,104                                   69
  104 CONTINUE                                                                70
      IF (IPTOPT.LT.1) GO TO 1003                                             71
      X=FLOAT(IX)                                                             72
      Y=FLOAT(IY)                                                             73
      Z=FLOAT(IZ)                                                             74
 1003 CONTINUE                                                                75
      ICNT=ICNT+1                                                             76
      IF (ICNT.EQ.1) 300,400                                                  77
  300 CONTINUE                                                                78
       MINWRD2=MAXWRD2=Y                                                      79
       MINWRD3=MAXWRD3=X                                                      80
  400 CONTINUE                                                                81
      IF (MINWRD2.GT.Y) MINWRD2=Y                                             82
      IF (MINWRD3.GT.X) MINWRD3=X                                             83
      IF (MAXWRD2.LT.Y) MAXWRD2=Y                                             84
      IF (MAXWRD3.LT.X) MAXWRD3=X                                             85
      IX=IFIX(X)$IY=IFIX(Y)$IZ=IFIX(Z)                                        86
      X=X-1.0E20                                                              87
      Y=Y-1.0E20                                                              88
      IF (ISRTOPT.LT.1) IDIST=IFIX(Y/DIST)                                    89
      IF (ISRTOPT.GE.1) IDIST=IFIX(X/DIST)                                    90
      CALL RECOUT (8,1,0,ICODE,IX,IY,IZ,IDIST)                                91
      IF (ISRT.LT.1) CALL RECOUT (7,1,0,ICODE,IX,IY,IZ,IDIST)                 92
      GO TO 100                                                               93
 1002 CONTINUE                                                                94
      KORE(1)=KORE(4)=MINWRD3                                                 95
      KORE(2)=KORE(3)=MAXWRD3                                                 96
      KORN(1)=KORN(2)=MAXWRD2                                                 97
      KORN(3)=KORN(4)=MINWRD2                                                 98
      ICODE=9                                                                 99
      IDIST=0                                                                100
      IX=IY=IZ=0                                                             101
      IF (ISRT.LT.1) CALL RECOUT (7,1,0,ICODE,IX,IY,IZ,IDIST)                102
      CALL RECOUT (8,1,0,ICODE,IX,IY,IZ,IDIST)                               103
      ICODE=99                                                               104
      IF (ISRT.LT.1) CALL RECOUT (7,1,0,ICODE,IX,IY,IZ,IDIST)                105
      CALL RECOUT (8,1,0,ICODE,IX,IY,IZ,IDIST)                               106
      REWIND 8                                                               107
      REWIND 7                                                               108
      RETURN                                                                 109
      END                                                                    110
      OVERLAY (LINK,2,0)                                                     111
      PROGRAM SORTIT                                                         112
      COMMON /BLK15/ IRDTP,IPTOPT,ISRTOPT                                    113
      COMMON /LINKDC/ LINK,RECALL                                            114
      DIMENSION ISM(5),IFN(2),KEY(16)                                        115
      REWIND 7                                                               116
      REWIND 8                                                               117
      ISM(1)=1                                                               118
      ISM(2)=4                                                               119
      ISM(3)=60                                                              120
      ISM(4)=1HF                                                             121
      ISM(5)=1HB                                                             122
      IFN(1)=5LTAPE7                                                         123
      IFN(2)=5LTAPE8                                                         124
      KEY(1)=1HA                                                             125
      KEY(2)=1HX                                                             126
      KEY(3)=2                                                               127
      KEY(6)=1HX                                                             128
      KEY(10)=1HX                                                            129
      KEY(13)=1HA                                                            130
      KEY(14)=1HX                                                            131
      KEY(15)=5                                                              132
      IF (ISRTOPT.GE.1) GO TO 1000                                           133
      KEY(5)=1HD                                                             134
      KEY(7)=6                                                               135
      IF (ISRTOPT.EQ.-1) KEY(7)=4                                            136
      KEY(9)=1HA                                                             137
      KEY(11)=3                                                              138
      GO TO 1001                                                             139
 1000 CONTINUE                                                               140
      KEY(5)=1HA                                                             141
      KEY(7)=6                                                               142
      IF (IS RTOPT.EQ.2) KEY(7)=3                                            143
      KEY(9)=1HD                                                             144
      KEY(11)=4                                                              145
 1001 CONTINUE                                                               146
      CALL SORT2(ISM,IFN,KEY)                                                147
      END FILE 7                                                             148
      RETURN                                                                 149
      END                                                                    150
      OVERLAY (LINK,3,0)                                                     151
      PROGRAM COUPLE                                                         152
      DIMENSION MAT(60,60)                                                   153
      COMMON /BLK1/ MAT                                                      154
      COMMON /LINKDC/ LINK,RECALL                                            155
      DO 1 I=1,60                                                            156
      DO 1 J=1,60                                                            157
    1 MAT(I,J)=0                                                             158
      CALL OVERLAY(LINK,3,1,RECALL)                                          159
      CALL OVERLAY (LINK,3,3,RECALL)                                         160
      CALL OVERLAY(LINK,3,2,RECALL)                                          161
      RETURN                                                                 162
      END                                                                    163
      OVERLAY (LINK,3,1)                                                     164
      PROGRAM MATCAL                                                         165
      COMMON /LINKDC/ LINK,RECALL                                            166
      REWIND 7                                                               167
      CALL GRIDIT                                                            168
      CALL REGRID                                                            169
      RETURN                                                                 170
      END                                                                    171
      SUBROUTINE GRIDIT                                                      172
      DIMENSION RESULT (2)                                                   173
      DIMENSION IK(100)                                                      174
      DIMENSION RS(100)                                                      175
      DIMENSION AA(3,3),BB(3,1),A(1000),B(1000),C(1000),D(3,1000),BSAVE(     176
     13,100),DSAVE(3),IPIVOT(3),INDEX(3,2)                                   177
      DIMENSION E(3)                                                         178
      DIMENSION            MAT(60,60),KORN(4),KORE(4)                        179
      DIMENSION GRAD(3),GRADCO(3,3)                                          180
      INTEGER S                                                              181
      REAL MINWRD2,MAXWRD2,MINWRD3,MAXWRD3                                   182
      COMMON /BLK1/ MAT                                                      183
      COMMON /BLK2/ KORE,KORN,IFYP,SCLE                                      184
      COMMON /BLK3/ JJ,KK                                                    185
      COMMON /BLK4/ DIST,TANG                                                186
      COMMON /BLK5/ MINWRD2,MAXWRD2,MINWRD3,MAXWRD3                          187
      COMMON /BLK6/ SP,SPP,LAST,DISPGRD                                      188
      COMMON /BLK40/ KMAX,KMAX1,IDMX                                         189
      COMMON /LIMITS/ MINI,MAXI,IADDI                                        190
 2000 FORMAT (7X*CORNER COORDINATES OF AREA TO BE CONTOURED*/)               191
 2002 FORMAT (* NORTH WEST CORNER--X=*E16.8*  Y=* E16.8 )                    192
 2003 FORMAT (* SOUTH EAST CORNER--X=*E16.8*  Y=* E16.8)                     193
 2004 FORMAT (1X, *Y DIMENSION OF DEPTH MATRIX IS*,F15.5,*INCHES*)           194
 2005 FORMAT (1X, *X DIMENSION OF DEPTH MATRIX IS*,F15.5,*INCHES*/)          195
 2006 FORMAT (1X,I4,*ELEMENTS IN Y DIRECTION OF DEPTH MATRIX*)               196
 2007 FORMAT (1X,I4,*ELEMENTS IN X DIRECTION OF DEPTH MATRIX*/)              197
      ICNT=0                                                                 198
      RSAVE=DIST                                                             199
      IDEPSUM=0                                                              200
      PRINT 243                                                              201
  240 FORMAT(* DEPTH MATRIX SIZE*/)                                          202
  241 FORMAT(/)                                                              203
  242 FORMAT(* THUS,*)                                                       204
      LABL=0                                                                 205
      CSLOPE1=1.0/SQRT(1.0+TANG**2)                                          206
      CSLOPE=0.9                                                             207
      IF (CSLOPE.GT.CSLOPE1) CSLOPE=CSLOPE1                                  208
  243 FORMAT(1H1,* THE FOLLOWING IS INFORMATION PERTAINING TO THE DEPTH      209
     1MATRIX--SIZE,DIMENSIONS,ETC.*///)                                      210
      MINMAX=0                                                               211
      IF (MINI.NE.0.OR.MAXI.NE.0) MINMAX=1                                   212
      IF (MINMAX.EQ.0) 200,201                                               213
  200 MINI=200000                                                            214
      MAXI=-200000                                                           215
  201 CONTINUE                                                               216
      SP=DIST                                                                217
      IPTOK=0                                                                218
      CALL CONVERT(SP)                                                       219
      PRINT 2000                                                             220
      PRINT 2002 ,MINWRD3,MAXWRD2                                            221
      PRINT 2003,MAXWRD3,MINWRD2                                             222
      CALL CONVERT (DISPGRD)                                                 223
    8 FORMAT (F5.2,F10.4,2I5,I5)                                             224
   10 FORMAT (2I10)                                                          225
      IF (IFYP) 4,3,4                                                        226
    3 IY=KORN(3)-KORN(1)                                                     227
      GO TO 2                                                                228
    4 IY=KORN(1)-KORN(3)                                                     229
    2 YMAX=FLOAT(IY)                                                         230
      CALL CONVERT(YMAX)                                                     231
      IX=KORE(3)-KORE(1)                                                     232
      XMAX=FLOAT(IX)                                                         233
      CALL CONVERT(XMAX)                                                     234
      JJ=IFIX(YMAX/SP)+1                                                     235
      KK=IFIX(XMAX/SP)+1                                                     236
      IF (XMAX-FLOAT(KK-1)*SP.GT.0.0) KK=KK+1                                237
      IF (YMAX-FLOAT(JJ-1)*SP.GT.0.0) JJ=JJ+1                                238
      IF (KK.LT.3.OR.JJ.LT.3) 301,302                                        239
  302 CONTINUE                                                               240
      IF (KK.GT.60.OR.JJ.GT.60) 230,231                                      241
  301 PRINT 300                                                              242
      GO TO 304                                                              243
  230 PRINT 232                                                              244
  304 CONTINUE                                                               245
      PRINT 2008                                                             246
      PRINT 2004,YMAX                                                        247
      PRINT 2005,XMAX                                                        248
      PRINT 240                                                              249
      PRINT 2006,JJ                                                          250
      PRINT 2007,KK                                                          251
  232 FORMAT(* SINCE  DIST IS TOO SMALL THE MAXIMUM DIMENSIONS OF THE DE     252
     1PTH MATRIX ARE EXCEEDED--I(60,60)*)                                    253
  300 FORMAT(* SINCE  DIST IS TOO LARGE THE MINIMUM DIMENSIONS OF THE DE     254
     1PTH MATRIX VIOLATED--I(3,3)*)                                          255
      GO TO 215                                                              256
  231 CONTINUE                                                               257
 2008 FORMAT(//* DIMENSIONS OF REQUIRED PLOTTING SURFACE EXCLUSIVE OF GR     258
     1ID*/)                                                                  259
      PRINT 2008                                                             260
      DO 180 J=1,JJ                                                          261
      DO 180 K=1,KK                                                          262
      MAT(J,K)=0                                                             263
  180 CONTINUE                                                               264
      K=1                                                                    265
      PRINT 2004,YMAX                                                        266
      PRINT 2005,XMAX                                                        267
      PRINT 2006,JJ                                                          268
      PRINT 2007,KK                                                          269
      TEST=1.0E+20                                                           270
      S=-2                                                                   271
      DO 740 I=1,1000                                                        272
      DO 740 J=1,3                                                           273
  740 D(J,I)=TEST                                                            274
  104 CALL RECIN(7,1,KKK,ICODE,IX,IY,IZ,IDIST)                               275
      IF (IFYP) 40,30,40                                                     276
   30 IY=(-1)*IY                                                             277
   40 CONTINUE                                                               278
      IF (ICODE.EQ.99) GO TO 221                                             279
      IF (ICNT.EQ.1000.AND.ICODE.LT.9) 202,203                               280
  202 PRINT 211                                                              281
      GO TO 215                                                              282
  211 FORMAT(* YOU HAVE OVER 1000 CONTROL POINTS.*/* ADDITIONAL CONTROL      283
     1POINTS CAN NOT BE ACCEPTED.*/* STORED DATA MAY NOT ADEQUATELY REPR     284
     2ESENT AREA TO BE CONTOURED.*)                                          285
  203 CONTINUE                                                               286
      IF (LABL.EQ.0) 204,205                                                 287
  204 IF (MINMAX.EQ.0) 212,213                                               288
  212 PRINT 206                                                              289
      LABL=1                                                                 290
      PRINT 242                                                              291
  206 FORMAT(* YOU HAVE ELECTED TO REJECT NO CONTROL POINTS*)                292
  207 FORMAT(* YOU HAVE ELECTED TO REJECT ALL CONTROL POINTS WITH SCALAR     293
     1 VARIATIONS LESS THAN*I6* AND GREATER THAN*I6)                         294
  208 FORMAT(* YOU HAVE A MINIMUM SCALAR VARIATION OF*I10)                   295
  209 FORMAT(* YOU HAVE A MAXIMUM SCALAR VARIATION OF*I10)                   296
      GO TO 210                                                              297
  213 PRINT 207,MINI,MAXI                                                    298
      LABL=1                                                                 299
      PRINT 242                                                              300
      IMINI=200000$IMAXI=-200000                                             301
  210 CONTINUE                                                               302
  214 FORMAT(* MUST TERMINATE PROGRAM EXECUTION WITH A MODE 4 FATAL ERRO     303
     1R*)                                                                    304
      GO TO 216                                                              305
  215 CONTINUE                                                               306
      PRINT 214                                                              307
      AZERO=0.0                                                              308
      AX=BX/AZERO                                                            309
      AY=AX*AX                                                               310
  216 CONTINUE                                                               311
  205 CONTINUE                                                               312
      IF (ICODE.EQ.9) 219,220                                                313
  219 IF (MINMAX.NE.0) PRINT 208,IMINI                                       314
      IF (MINMAX.NE.0) PRINT 209, IMAXI                                      315
      IF (MINMAX.EQ.0) PRINT 208,MINI                                        316
      IF (MINMAX.EQ.0) PRINT 209,MAXI                                        317
      IADDI=(-1)*(10000)*(MINI/10000)+10000                                  318
      MINI=MINI+IADDI$MAXI=MAXI+IADDI                                        319
      GO TO 221                                                              320
  220 IF (MINMAX.EQ.0) 217,218                                               321
  217 IF (IZ.LT.MINI) MINI=IZ                                                322
      IF (IZ.GT.MAXI) MAXI=IZ                                                323
      GO TO 221                                                              324
  218 CONTINUE                                                               325
      IF (IZ.LT.IMINI) IMINI=IZ                                              326
      IF (IZ.GT.IMAXI) IMAXI=IZ                                              327
  221 CONTINUE                                                               328
      B(1)=FLOAT(IX)                                                         329
      B(2)=FLOAT(IY)                                                         330
      IJUMP=-1                                                               331
      IF (ICODE-9) 100,1133,105                                              332
  100 CONTINUE                                                               333
 1133 CALL CKPOINT (B(1),B(2),IZ,IPTOK,ICODE)                                334
      IF (IPTOK.EQ.-1) GO TO 104                                             335
  103 CONTINUE                                                               336
      ICNT=ICNT+1                                                            337
 1103 D(1,ICNT)=B(1)                                                         338
      D(2,ICNT)=B(2)                                                         339
      B(3)=FLOAT(IZ)                                                         340
      D(3,ICNT)=B(3)                                                         341
      IF (ICODE.LT.9) GO TO 104                                              342
  105 CONTINUE                                                               343
      DO 700 J=1,ICNT                                                        344
      IF (D(1,J).EQ.TEST) GO TO 700                                          345
      DO 750 II=1,3                                                          346
      GRAD(II)=0.0                                                           347
      BB(II,1)=0.0                                                           348
      DO 750 IJ=1,3                                                          349
      AA(II,IJ)=0.0                                                          350
  750 CONTINUE                                                               351
      DXMX=DYMX=-1000.0                                                      352
      DXMN=DYMN=+1000.0                                                      353
      DO 705 N2=1,3                                                          354
      GRADCO(N2,1)=D(N2,J)                                                   355
  705 DSAVE(N2)=D(N2,J)                                                      356
      RSAVE=0.0                                                              357
      RSUM=0.0$RMAX=0.0                                                      358
      INUM=0                                                                 359
      JNUM=0                                                                 360
      DO 771 ID=1,100                                                        361
      RLAST=RSAVE                                                            362
      RSAVE=RSAVE+DIST/(10.0)                                                363
      DO 701 I=1,ICNT                                                        364
      R=0.0                                                                  365
      IF (INUM.EQ.100) GO TO 701                                             366
      IF (D(1,I).EQ.TEST.OR.I.EQ.J) GO TO 701                                367
      DO 703 N1=1,2                                                          368
      IF(N1.EQ.1)DX=DSAVE(N1)-D(N1,I)                                        369
      IF(N1.EQ.2)DY=DSAVE(N1)-D(N1,I)                                        370
  703 R=R+(DSAVE(N1)-D(N1,I))**2                                             371
      R=SQRT(R)                                                              372
      IF (R.GT.RSAVE) GO TO 701                                              373
      IF (R.LE.RLAST) GO TO 701                                              374
      IF (ABS((DSAVE(3)-D(3,I))         ) /R.GT.TANG.OR.ABS(DSAVE(3)-D(3     375
     1,I)).GT.IDMX) GO TO 701                                                376
      KADD=-1                                                                377
      IF (INUM.GE.KMAX1) 773,7774                                            378
  773 DO 775 I10=1,INUM                                                      379
      IF (RMAX.EQ.RS(I10)) 774,775                                           380
  774 CONTINUE                                                               381
      KADD=KADD+1                                                            382
      IF (KADD.GT.0) GO TO 7774                                              383
  775 CONTINUE                                                               384
      GO TO 772                                                              385
 7774 CONTINUE                                                               386
      IF (R.GT.RMAX) RMAX=R                                                  387
      INUM=INUM+1                                                            388
      RS(INUM)=R                                                             389
      DO 707 N4=1,3                                                          390
      DXMX=AMAX1(DXMX,DX)                                                    391
      DYMX=AMAX1(DYMX,DY)                                                    392
      DXMN=AMIN1(DXMN,DX)                                                    393
      DYMN=AMIN1(DYMN,DY)                                                    394
  707 BSAVE(N4,INUM)=D(N4,I)                                                 395
  701 CONTINUE                                                               396
  771 CONTINUE                                                               397
  772 CONTINUE                                                               398
      IF (INUM.LT.KMAX1) GO TO 751                                           399
      DO 712 I2=1,INUM                                                       400
  712 RSUM=RSUM+(1.0-RS(I2  )/RMAX)**2*(RS(I2) /RMAX)**S                     401
      RWSUM=RSUM                                                             402
      INUM1=INUM-1                                                           403
      DO 710 I1=1,INUM1,1                                                    404
      NNUM=I1                                                                405
      JNUM=I1+1$SUMSQ1=0.0$SUMSQ2=0.0                                        406
      DO  710 I6=JNUM,INUM,1                                                 407
      DO 770 J6=1,3                                                          408
      GRADCO(J6,2)=BSAVE(J6,I1)                                              409
      GRADCO(J6,3)=BSAVE(J6,I6)                                              410
      IF (J6.EQ.3) GO TO 770                                                 411
      SUMSQ1=(GRADCO(J6,2)-GRADCO(J6,1))**2                                  412
      SUMSQ2=(GRADCO(J6,3)-GRADCO(J6,1))**2                                  413
  770 CONTINUE                                                               414
      IF (SUMSQ1.EQ.0.0) GO TO 710                                           415
      IF (SUMSQ2.EQ.0.0) GO TO 710                                           416
      RTSMSQ1=SQRT(SUMSQ1)                                                   417
      RTSMSQ2=SQRT(SUMSQ2)                                                   418
      SALPHA1=ABS(GRADCO(2,2)/RTSMSQ1)                                       419
      SALPHA2=ABS(GRADCO(2,3)/RTSMSQ2)                                       420
      CALPHA1=ABS(GRADCO(1,2)/RTSMSQ1)                                       421
      CALPHA2=ABS(GRADCO(1,3)/RTSMSQ2)                                       422
      SDIFALP=SALPHA2*CALPHA1-CALPHA2*SALPHA1                                423
      IF (ABS(SDIFALP  )-00.17365.LT.0.0) GO TO 710                          424
      DG=GRADCO(1,1)*(GRADCO(2,2)*GRADCO(3,3)-GRADCO(3,2)*GRADCO(2,3))       425
     1-GRADCO(2,1)*(GRADCO(1,2)*GRADCO(3,3)-GRADCO(3,2)*GRADCO(1,3))         426
     2+GRADCO(3,1)*(GRADCO(1,2)*GRADCO(2,3)-GRADCO(2,2)*GRADCO(1,3))         427
      IF(DG.EQ.0.0)GO TO 710                                                 428
      GRAD(1)=(GRADCO(2,2)*GRADCO(3,3)-GRADCO(3,2)*GRADCO(2,3)-GRADCO(2,     429
     11)*(GRADCO(3,3)-GRADCO(3,2))+GRADCO(3,1)*(GRADCO(2,3)-GRADCO(2,2))     430
     2)/DG                                                                   431
      GRAD(2)=(GRADCO(1,1)*(GRADCO(3,3)-GRADCO(3,2))-(GRADCO(3,3)*GRADCO     432
     1(1,2)-GRADCO(3,2)*GRADCO(1,3))+(GRADCO(3,1)*(GRADCO(1,2)-GRADCO(1,     433
     23))))/DG                                                               434
      GRAD(3)=(GRADCO(1,1)*(GRADCO(2,2)-GRADCO(2,3))-GRADCO(2,1)*(GRADCO     435
     1(1,2)-GRADCO(1,3))+GRADCO(1,2)*GRADCO(2,3)-GRADCO(2,2)*GRADCO(1,3)     436
     2)/DG                                                                   437
      RW=SQRT((DSAVE(1)-BSAVE(1,I1))**2+(DSAVE(2)-BSAVE(2,I1))**2)/RMAX      438
      W=SQRT((1.0-RW)**2*RW**S/RWSUM)                                        439
      E(1)=W*(BSAVE(1,I1)-DSAVE(1))                                          440
      E(2)=W*(BSAVE(2,I1)-DSAVE(2))                                          441
      E(3)=W*(BSAVE(3,I1)-DSAVE(3))                                          442
      DO 711 J1=1,3                                                          443
      BB(J1,1)=BB(J1,1)-E(J1)*(E(1)*GRAD(1)+E(2)*GRAD(2)+E(3)*GRAD(3))       444
     1*(-1.0)                                                                445
      DO 711 J2=1,3                                                          446
      AA(J1,J2)=AA(J1,J2)+E(J1)*E(J2)                                        447
  711 CONTINUE                                                               448
  710 CONTINUE                                                               449
      IF (JNUM.EQ.1) GO TO 780                                               450
      CALL MATINV(AA,3,BB,1,DETERM,IPIVOT,INDEX,3,ISCALE)                    451
      DO 1700 IA=1,3                                                         452
      IV=LEGVAR(BB(IA,1))                                                    453
      IF (IV) 751,1700,751                                                   454
 1700 CONTINUE                                                               455
      IF (DETERM.EQ.0.0) GO TO 751                                           456
      DC=BB(3,1)                                                             457
      A(J)=BB(1,1)                                                           458
      B(J)=BB(2,1)                                                           459
      IF((DC.EQ.0.0).AND.(A(J).EQ.0.0).AND.(B(J).EQ.0.0)) GO TO 751          460
      BB(3,1)=DC/SQRT(DC**2+A(J)**2+B(J)**2)                                 461
      GO TO 781                                                              462
  780 CONTINUE                                                               463
      A(J)=GRAD(1)                                                           464
      B(J)=GRAD(2)                                                           465
      DC=GRAD(3)                                                             466
      GO TO 751                                                              467
  781 CONTINUE                                                               468
      TXY=(DYMX-DYMN)/(DXMX-DXMN)                                            469
      BB(3,1)=ABS(BB(3,1))                                                   470
      IF (BB(3,1).LT.CSLOPE) GO TO 751                                       471
      A(J)=-A(J)/DC                                                          472
      B(J)=-B(J)/DC                                                          473
      C(J)=-(A(J)*DSAVE(1)+B(J)*DSAVE(2)-DSAVE(3))                           474
      GO TO 700                                                              475
  751 A(J)=TEST                                                              476
      B(J)=TEST                                                              477
      C(J)=TEST                                                              478
  700 CONTINUE                                                               479
      DO 720 I=1,KK                                                          480
      X=KORE(1)+DIST*FLOAT(I-1)                                              481
      DO 720 J=1,JJ                                                          482
      Y=KORN(1)-DIST*FLOAT(J-1)                                              483
      RMAX=0.0                                                               484
      RSAVE=0.0                                                              485
      INUM=0                                                                 486
      DO 742 L=1,100                                                         487
      RLAST=RSAVE                                                            488
      RSAVE=DIST*FLOAT(L)/(10.0)                                             489
      DO 741 II=1,ICNT                                                       490
      KADD=-1                                                                491
      IF (INUM.GE.KMAX) 776,7777                                             492
  776 DO 778 I3=1,INUM                                                       493
      IF (SQRT((D(1,II)-X)**2+(D(2,II)-Y)**2).EQ.RMAX) 777,778               494
  777 CONTINUE                                                               495
      KADD=KADD+1                                                            496
      IF (KADD.GT.0) GO TO 7777                                              497
  778 CONTINUE                                                               498
      GO TO 744                                                              499
 7777 CONTINUE                                                               500
      IF (A(II).EQ.TEST.AND.B(II).EQ.TEST) GO TO 741                         501
      DR=SQRT((D(1,II)-X)**2+(D(2,II)-Y)**2)                                 502
      IF (DR.GT.RSAVE) GO TO 741                                             503
      IF (DR.LE.RLAST) GO TO 741                                             504
      IF (DR.GT.RMAX) RMAX=DR                                                505
      INUM=INUM+1                                                            506
      IK(INUM)=II                                                            507
  741 CONTINUE                                                               508
  742 CONTINUE                                                               509
  744 CONTINUE                                                               510
      IF(INUM.EQ.0)GO TO 720                                                 511
      RD=0.0                                                                 512
      DO 730 I1=1,INUM                                                       513
      I4=IK(I1)                                                              514
      R=SQRT((X-D(1,I4))**2+(Y-D(2,I4))**2)/RMAX                             515
  730 RD=RD+(1.0-R)**2*R**S                                                  516
      IF(RD.EQ.0.0)GO TO 720                                                 517
      DO 731 I2=1,INUM                                                       518
      I4=IK(I2)                                                              519
      RS=SQRT((X-D(1,I4))**2+(Y-D(2,I4))**2)                                 520
      MAT(J,I)=MAT(J,I)+(1.0-RS/RMAX)**2*(RS/RMAX)**S/RD*(C(I4)+A(I4)*X+     521
     1B(I4)*Y)                                                               522
  731 CONTINUE                                                               523
      MAT(J,I)=MAT(J,I)+IADDI                                                524
  720 CONTINUE                                                               525
 3333 RETURN                                                                 526
      END                                                                    527
      SUBROUTINE REGRID                                                      528
      INTEGER AGAIN                                                          529
      DIMENSION I(60,60)                                                     530
      COMMON /BLK1/ I                                                        531
      COMMON /BLK3/ KM,LM                                                    532
      COMMON /BLK4/ DIST,TANG,M                                              533
      COMMON /LIMITS/ MINI,MAXI,IADDI                                        534
  600 FORMAT (* MINIMUM ELEVATION PRIOR TO SMOOTHING = *I10)                 535
  601 FORMAT (* MAXIMUM ELEVATION PRIOR TO SMOOTHING = *I10,/)               536
  602 FORMAT(/,* MINIMUM ELEVATION AFTER INTERPOLATION ETC = *,I10,/)        537
  603  FORMAT (* MAXIMUM EXPECTED SLOPE BETWEEN TWO CONSECUTIVE GRID POI     538
     1NTS  =  *,F15.5)                                                       539
  604 FORMAT (20I6)                                                          540
  605 FORMAT (10I5)                                                          541
  607 FORMAT (* UNSMOOTHED DEPTH MATRIX* //)                                 542
  606 FORMAT (* SMOOTHED DEPTH MATRIX*//)                                    543
   25 FORMAT (I10,I10)                                                       544
    6 FORMAT (I3,F10.0,F10.5)                                                545
    5 FORMAT (20I4)                                                          546
      IF (      MINI.LT.1000) 300,302                                        547
  300 PRINT 301                                                              548
  301 FORMAT(* YOU ARE IN SUBROUTINE REGRID WITH A MINIMUM SCALAR VARIAT     549
     1ION WHICH IS TOO SMALL*/* CHECK  LAST MINIMUM SCALAR VARIATION IF      550
     2PROGRAM FAILS TO EXECUTE PROPERLY*)                                    551
  302 CONTINUE                                                               552
  310 FORMAT(1H1,* THE FOLLOWING INFORMATION REGARDING YOUR UNSMOOTHED D     553
     1EPTH MATRIX IS FURNISHED*///)                                          554
  311 FORMAT(/)                                                              555
  312 FORMAT(1H1,* THE FOLLOWING INFORMATION REGARDING THE SMOOTHED DEPT     556
     1H MATRIX IS FURNISHED*///)                                             557
      PRINT 310                                                              558
      CALL TESTI                                                             559
      PRINT 311                                                              560
      M=1                                                                    561
      MCNT=0                                                                 562
      PRINT 607                                                              563
      DO 711 K=1,KM                                                          564
      PRINT 604,(I(K,J),J=1,LM)                                              565
      DO 711 L=1,LM                                                          566
      IF (I(K,L).LT.MINI.OR.I(K,L).GT.MAXI) I(K,L)=0                         567
      IF (I(K,L).EQ.0) MCNT=MCNT+1                                           568
      IF (I(K,L).NE.0) 800,801                                               569
  800 IF (MCNT.GT.M) M=MCNT                                                  570
      MCNT=0                                                                 571
  801 CONTINUE                                                               572
  711 CONTINUE                                                               573
      PRINT 312                                                              574
      IF (M.EQ.0) PRINT 313                                                  575
  313 FORMAT(* IT HAS BEEN DETERMINED THAT EACH ELEMENT OF YOUR UNSMOOTH     576
     1ED DEPTH MATRIX IS FILLED*/* NO ELEMENT WAS FOUND TO EXCEED THE LI     577
     2MITS ESTABLISHED BY YOU*/)                                             578
      IF (M.NE.0) PRINT 314                                                  579
  314 FORMAT(* IT HAS BEEN DETERMINED THAT EACH ELEMENT OF YOUR UNSMOOTH     580
     1ED DEPTH MATRIX IS INADEQUATELY FILLED*/)                              581
      CALL TESTI                                                             582
      PRINT 311                                                              583
      JCNT=0                                                                 584
      ICHEAT=0                                                               585
C     THIS SECTION FINDS MIN AND MAX DEPTHS                                  586
      IMIN=20000                                                             587
      IMAX=-10000                                                            588
      DO 710 K=1,KM                                                          589
      DO 710 L=1,LM                                                          590
      IF (I(K,L).GT.IMAX) 701,702                                            591
  701 IMAX=I(K,L)                                                            592
  702 IF (I(K,L).LT.IMIN.AND.I(K,L).GT.0) 703,710                            593
  703 IMIN=I(K,L)                                                            594
  710 CONTINUE                                                               595
      MAXL=IMAX-IADDI                                                        596
      MINL=IMIN-IADDI                                                        597
      PRINT 315                                                              598
  315 FORMAT(* REGRID WILL NOT PERMIT THE INTERNAL ELEMENTS OF I TO EXCE     599
     1ED THE FOLLOWING LIMITS*/)                                             600
      PRINT 600,MINL                                                         601
      PRINT 601,MAXL                                                         602
  700 ICNT=0                                                                 603
      AGAIN=500.0                                                            604
      K1=KM-1                                                                605
      L1=LM-1                                                                606
      IF (M.EQ.0) 1001,1                                                     607
    1 CONTINUE                                                               608
C     THIS SECTION LINEARLY INTERPOLATES TO FILL MISSING INTERIOR GRID P     609
      DO 20 K=2,K1                                                           610
      DO 20 L=2,L1                                                           611
      IF (I(K,L).EQ.0) 10,11                                                 612
   11 I(K,L)=I(K,L)                                                          613
      GO TO 20                                                               614
   10 IF (I(K-1,L).EQ.0.OR.I(K+1,L).EQ.0) 12,13                              615
   13 I(K,L)=(I(K-1,L)+I(K+1,L))/2                                           616
      GO TO 20                                                               617
   12  IF (I(K,L-1).EQ.0.OR.I(K,L+1).EQ.0) 14,15                             618
   15 I(K,L)=(I(K,L-1)+I(K,L+1))/2                                           619
      GO TO 20                                                               620
   14 IF (I(K+1,L).EQ.0.OR.I(K,L+1).EQ.0)  8,17                              621
   17 I(K,L)=(I(K+1,L)+I(K,L+1))/2                                           622
      GO TO 20                                                               623
    8 IF (I(K-1,L).EQ.0.OR.I(K,L-1).EQ.0) 16,7                               624
    7 I(K,L)=(I(K-1,L)+I(K,L-1))/2                                           625
      GO TO 20                                                               626
   16 IF (I(K,L+1).EQ.0.OR.I(K-1,L).EQ.0) 18,19                              627
   19 I(K,L) =(I(K,L+1)+I(K-1,L))/2                                          628
      GO TO 20                                                               629
   18 IF(I(K+1,L).EQ.0.OR.I(K,L-1).EQ.0)20,21                                630
   21 I(K,L)=(I(K+1,L)+I(K,L-1))/2                                           631
   20 CONTINUE                                                               632
      ICNT=ICNT+1                                                            633
      IF (ICNT.EQ.M) 23,1                                                    634
   23 CONTINUE                                                               635
C     FILL BLANKS I(1,L) BY LINEAR INTERPOLATION                             636
      DO 90 L=2,L1                                                           637
      DO 90 K=1,1                                                            638
      IF (I(K,L).EQ.0) 91,90                                                 639
   91 IF (I(K,L+1).EQ.0.OR.I(K,L-1).EQ.0) 90,92                              640
   92 I(K,L)=(I(K,L+1)+I(K,L-1))/2                                           641
   90 CONTINUE                                                               642
C     FILL BLANKS I(1,L) BY EXTRAPOLATION                                    643
      DO 50 L=1,LM                                                           644
      DO 50 K=1,1                                                            645
      IF (I(K,L).EQ.0.AND.(I(K+1,L).NE.0.AND.I(K+2,L).NE.0)) 51,50           646
   51 J=I(K+1,L)-I(K+2,L)                                                    647
      I (K,L)=I(K+1,L)+J                                                     648
   50 CONTINUE                                                               649
C     FILL BLANKS I(K,1) BY LINEAR INTERPOLATION                             650
      DO 30 K=2,K1                                                           651
      DO 30 L=1,1                                                            652
      IF (I(K,L).EQ.0) 31,30                                                 653
   31 IF (I(K+1,L).EQ.0.OR.I(K-1,L).EQ.0) 30,32                              654
   32 I(K,L)=(I(K+1,L)+I(K-1,L))/2                                           655
   30 CONTINUE                                                               656
C     FILL BLANKS I(K,1) BY EXTRAPOLATION                                    657
      DO 55K=1,KM                                                            658
      DO 55 L=1,1                                                            659
      IF (I(K,L).EQ.0.AND.(I(K,L+1).NE.0.AND.I(K,L+2).NE.0)) 56,55           660
   56 J=I(K,L+1)-I(K,L+2)                                                    661
      I(K,L)=I(K,L+1)+J                                                      662
   55 CONTINUE                                                               663
C     FILL BLANKS I(KM,L) BY LINEAR INTERPOLATION                            664
      DO 35 K=KM,KM                                                          665
      DO 35 L=2,L1                                                           666
      IF (I(K,L).EQ.0) 36,35                                                 667
   36 IF (I(K,L+1).EQ.0.OR.I(K,L-1).EQ.0) 35,37                              668
   37 I(K,L)=(I(K,L+1)+I(K,L-1))/2                                           669
   35 CONTINUE                                                               670
C     FILL BLANKS I(KM,L) BY EXTRAPOLATION                                   671
      DO 60 K=KM,KM                                                          672
      DO 60 L=1,LM                                                           673
      IF (I(K,L).EQ.0.AND.(I(K-1,L).NE.0.AND.I(K-2,L).NE.0)) 61,60           674
   61 J=I(K-1,L)-I(K-2,L)                                                    675
      I(K,L)=I(K-1,L)+J                                                      676
   60 CONTINUE                                                               677
C     FILL BLANKS I(K,LM) BY LINEAR INTERPOLATION                            678
      DO 670 K=2,K1                                                          679
      DO 670 L=LM,LM                                                         680
      IF (I(K,L).EQ.0) 671,670                                               681
  671 IF (I(K+1,L).EQ.0.OR.I(K-1,L).EQ.0) 670,672                            682
  672 I(K,L)=(I(K+1,L)+I(K-1,L))/2                                           683
  670 CONTINUE                                                               684
C     FILL BLANKS I(K,LM) BY EXTRAPOLATION                                   685
      DO 65 K=1,KM                                                           686
      DO 65 L=LM,LM                                                          687
      IF (I(K,L).EQ.0.AND.(I(K,L-1).NE.0.AND.I(K,L-2).NE.0)) 66,65           688
   66 J=I(K,L-1)-I(K,L-2)                                                    689
      I(K,L)=I(K,L-1)+J                                                      690
   65 CONTINUE                                                               691
C     AT THIS POINT ALL BLANKS ARE FILLED                                    692
 1001 CONTINUE                                                               693
      ICNTI=0                                                                694
      IF (JCNT.GT.0) 999,998                                                 695
  998 CONTINUE                                                               696
      DO 997 K=1,KM                                                          697
      DO 997 L=1,LM                                                          698
      IF (I(K,L).GT.IMAX.OR.I(K,L).LT.IMIN) 996,997                          699
  996 I(K,L)=0                                                               700
  350 FORMAT(* BE CAUTIOUS OF ELEMENT I(*I2*,*I2*)*)                         701
      PRINT 350,K,L                                                          702
      ICNTI=ICNTI+1                                                          703
  997 CONTINUE                                                               704
      M=20$JCNT=1                                                            705
      IF (ICNTI.EQ.0) GO TO 999                                              706
      GO TO 700                                                              707
  999 CONTINUE                                                               708
    4 FORMAT (2X,20I5)                                                       709
      IF (I(1,1).GT.I(1,2))76,77                                             710
   77 MIN=I(1,1)                                                             711
      GO TO 78                                                               712
   76 MIN=I(1,2)                                                             713
   78 CONTINUE                                                               714
      DO 75 K=2,K1                                                           715
      DO 75 L=2,L1                                                           716
      IF (I(K,L).GT.MIN) 75,80                                               717
   80 CONTINUE                                                               718
      MIN=I(K,L)                                                             719
   75 CONTINUE                                                               720
      MINL=MIN-IADDI                                                         721
      PRINT 602,MINL                                                         722
      IF (JCNT.EQ.3) GO TO 305                                               723
      IF (MIN.GE.1000) 81,303                                                724
  303 IF (JCNT.EQ.1) 304,305                                                 725
  304 PRINT 306                                                              726
  306 FORMAT(* MINIMUM SCALAR VARIATION IN INTERNAL ELEMENTS OF I MATRIX     727
     1 IS TOO SMALL*/* WILL TRY TO SMOOTH AND THEN EVALUATE AGAIN*/)         728
      GO TO 81                                                               729
  305 PRINT 307                                                              730
  307 FORMAT(* HAVE TRIED TO EVALUATE DEPTH MATRIX*/* WILL PRINT I MATRI     731
     1X BEFORE TERMINATING YOUR JOB*/* PLEASE CHECK AND RESUBMIT*//)         732
      DO 320 K=1,KM                                                          733
      PRINT 604,(I(K,L),L=1,LM)                                              734
  320 CONTINUE                                                               735
      PRINT 308                                                              736
  308 FORMAT(* POSSIBLE REASONS FOR FAILURE*//* ABSOLUTE VALUE OF MINIMU     737
     1M AND MAXIMUM SCALAR VARIATIONS MAY BE TOO LARGE*/* DISTANCE BETWE     738
     2EN GRID POINTS NEEDS ADJUSTING*/* INSUFFICIENT CONTROL POINT DENSI     739
     3TY*/*  MAXIMUM SLOPE BETWEEN DATA AND/OR GRID POINTS NEEDS ADJUSTI     740
     4NG*)                                                                   741
      PRINT 309                                                              742
  309 FORMAT(* PROGRAM EXECUTION TERMINATED WITH A MODE 4 FATAL ERROR*)      743
      AZERO=0.0                                                              744
      AX=BX/AZERO                                                            745
      AY=AX*AX                                                               746
   82 CONTINUE                                                               747
      PRINT 606                                                              748
      DO 9912 K=1,KM                                                         749
      PRINT 604,(I(K,L),L=1,LM)                                              750
 9912 CONTINUE                                                               751
      REWIND 8                                                               752
      RETURN                                                                 753
   81 TAM=TANG                                                               754
      PRINT 603,TAM                                                          755
      PRINT 311                                                              756
      K2=KM-2                                                                757
      L2=LM-2                                                                758
      DO 95 K=1,K2                                                           759
      DO 95 L=1,L2                                                           760
      KP1=K+1                                                                761
      KP2=K+2                                                                762
      LP1=L+1                                                                763
      LP2=L+2                                                                764
      T1=ABS((      I(K,L)-I(KP1,L))/DIST)                                   765
      IF (TAM-T1) 100,95,95                                                  766
  100 T2=      (I(KP1,L)-I(KP2,L))/DIST                                      767
      T3=ABS(T2)                                                             768
      IF (TAM-T3) 102,103,103                                                769
  103 I(K,L)=I(KP1,L)+(I(KP1,L)-I(KP2,L))                                    770
      GO TO 95                                                               771
  102 T4=ABS(     (I(K,LP1)-I(K,LP2))/DIST)                                  772
      IF (TAM-T4) 105,106,106                                                773
  106 I(K,L)=I(K,LP1)+(I(K,LP1)-I(K,LP2))                                    774
      GO TO 95                                                               775
  105 I(K,L)=0                                                               776
   95 CONTINUE                                                               777
      DO 110 K=1,K2                                                          778
      DO 110 L=1,L2                                                          779
      LP2=L+2                                                                780
      KP2=K+2                                                                781
      LP1=L+1                                                                782
      KP1=K+1                                                                783
      T10=ABS(     (I(K,L)-I(K,LP1))/DIST)                                   784
      IF (TAM-T10) 200,110,110                                               785
  200 T20=(     I(K,LP1)-I(K,LP2))/DIST                                      786
      T30=ABS(T20)                                                           787
      IF (TAM-T30) 202,203,203                                               788
  203 I(K,L)=I(K,LP1)+(I(K,LP1)-I(K,LP2))                                    789
      GO TO 110                                                              790
  202 I(K,L)=0                                                               791
  110 CONTINUE                                                               792
      DO 650 K=1,KM                                                          793
      DO 650 L=1,LM                                                          794
      IF (I(K,L).GT.IMAX.OR.I(K,L).LT.IMIN) 651,650                          795
  651 I(K,L)=0                                                               796
  650 CONTINUE                                                               797
      DO 500 K=1,KM                                                          798
      DO 500 L=1,LM                                                          799
      IF (I(K,L).EQ.0) 501,500                                               800
  501 AGAIN=0                                                                801
  500 CONTINUE                                                               802
      JCNT=JCNT+1                                                            803
      IF (AGAIN.EQ.0) 700,82                                                 804
      END                                                                    805
      SUBROUTINE CKPOINT (XIN1,YIN1,IDEP1,IPTOK,ICODE)                       806
      IF (ICODE.EQ.9) GO TO 1124                                             807
      IF (IPTOK.EQ.0) 103,105                                                808
 1123 CONTINUE                                                               809
      IDEP2=IDEPSUM/IDENOM                                                   810
      IDEPSUM=0                                                              811
      IDENOM=1                                                               812
      GO TO 1133                                                             813
 1113 IDENOM=IDENOM+1                                                        814
      IDEPSUM=IDEPSUM+IDEP1                                                  815
      IPTOK=-1                                                               816
      GO TO 104                                                              817
  103 IPTOK=-1                                                               818
      IDENOM=1                                                               819
      XIN2=XIN1                                                              820
      YIN2=YIN1                                                              821
      IDEP2=IDEP1                                                            822
      IDEPSUM=IDEP2                                                          823
      GO TO 104                                                              824
  105 CONTINUE                                                               825
      IF (YIN1.EQ.YIN2.AND.XIN1.EQ.XIN2) GO TO 1113                          826
 1124 IF (IDENOM.GT.1) GO TO 1123                                            827
 1133 CONTINUE                                                               828
      TEMP=XIN2                                                              829
      XIN2=XIN1                                                              830
      XIN1=TEMP                                                              831
      TEMP=YIN2                                                              832
      YIN2=YIN1                                                              833
      YIN1=TEMP                                                              834
      TEMP=IDEP2                                                             835
      IDEP2=IDEP1                                                            836
      IDEP1=TEMP                                                             837
      IDEPSUM=IDEP2                                                          838
      IPTOK=1                                                                839
      IF(ICODE.EQ.9)IPTOK=0                                                  840
  104 RETURN                                                                 841
      END                                                                    842
      SUBROUTINE TESTI                                                       843
      REAL MINWRD2,MAXWRD2,MINWRD3,MAXWRD3                                   844
      DIMENSION IROW(2),ICOL(2)                                              845
      COMMON /BLK1/ I(60,60)                                                 846
      COMMON /BLK3/ KM,LM                                                    847
      COMMON /BLK5/ MINWRD2,MAXWRD2,MINWRD3,MAXWRD3                          848
      COMMON /BLK4/ DIST                                                     849
  101 CONTINUE                                                               850
      DO 100 J=1,2                                                           851
      IROW(J)=0                                                              852
      DO 100 K=1,LM                                                          853
      IF (I(J,K).GT.0) IROW(J)=IROW(J)+1                                     854
  100 CONTINUE                                                               855
      IF (IROW(1)+IROW(2).GT.0) GO TO 302                                    856
      DO 300 J=1,KM                                                          857
      DO 300 L=1,LM                                                          858
  300 I(J,L)=I(J+1,L)                                                        859
      KM=KM-1                                                                860
      MAXWRD2=MAXWRD2-DIST                                                   861
      GO TO 101                                                              862
  302 J=KM                                                                   863
      IR=0                                                                   864
      DO 301 L=1,LM                                                          865
      IF (I(J,L).GT.0) IR=IR+1                                               866
  301 CONTINUE                                                               867
      IF (IR.GT.0) 201,304                                                   868
  304 KM=KM-1                                                                869
      MINWRD2=MINWRD2+DIST                                                   870
      GO TO 302                                                              871
  201 CONTINUE                                                               872
      DO 200 K=1,2                                                           873
      ICOL(K)=0                                                              874
      DO 200 J=1,KM                                                          875
      IF (I(J,K).GT.0) ICOL(K)=ICOL(K)+1                                     876
  200 CONTINUE                                                               877
      IF (ICOL(1)+ICOL(2).GT.0) GO TO 402                                    878
      DO 400 L=1,LM                                                          879
      DO 400 J=1,KM                                                          880
  400 I(J,L)=I(J,L+1)                                                        881
      LM=LM-1                                                                882
      MINWRD3=MINWRD3+DIST                                                   883
      GO TO 201                                                              884
  402 J=LM                                                                   885
      IR=0                                                                   886
      DO 401 L=1,KM                                                          887
      IF (I(L,J).GT.0) IR=IR+1                                               888
  401 CONTINUE                                                               889
      IF (IR.GT.0) 501,404                                                   890
  404 LM=LM-1                                                                891
      MAXWRD3=MAXWRD3-DIST                                                   892
      GO TO 402                                                              893
  501 CONTINUE                                                               894
      PRINT 1,MINWRD2,MAXWRD2,MINWRD3,MAXWRD3                                895
    1 FORMAT(/,                                                       *      896
     1ADJUSTED BOUNDARIES OF DEPTH MATRIX*//* MINIMUM Y*E16.8* MAXIMUM Y     897
     1*E16.8,/,* MINIMUM X*E16.8* MAXIMUM X*E16.8)                           898
      RETURN                                                                 899
      END                                                                    900
      SUBROUTINE CONVERT(X)                                                  901
      COMMON /BLK2/ KORE(4),KORN(4),IFYP,SCLE                                902
      COMMON/BLK14/ UNIT,CNVTOIN                                             903
      X=X*UNIT/(SCLE*CNVTOIN)                                                904
      RETURN                                                                 905
      END                                                                    906
      OVERLAY (LINK,3,3)                                                     907
      PROGRAM CKZFIT                                                         908
      DIMENSION XTAB(60),ZTAB(60),YTAB(3600),I(60,60),ARG(1000,2)            909
      DIMENSION KORE(4),KORN(4)                                              910
      DIMENSION YYTAB(60,60)                                                 911
      EQUIVALENCE (YYTAB,YTAB)                                               912
      COMMON /BLK1/ I                                                        913
      COMMON /BLK2/ KORE,KORN                                                914
      COMMON /BLK3/ KM,LM                                                    915
      COMMON /BLK4/ DIST                                                     916
      COMMON /LIMITS/ MINI,MAXI,IADDI                                        917
      COMMON /LINKDC/ LINK,RECALL                                            918
      PRINT 1                                                                919
    1 FORMAT(1H1,* YOUR SMOOTHED DEPTH MATRIX, I, IS PRINTED ABOVE.*/* A     920
     1T THIS POINT THE SCALAR VARIATIONS PREDICTED BY I AT THE LOCATION      921
     2OF EACH CONTROL POINT*/* IS COMPARED WITH THE SCALAR MAGNITUDE OF      922
     3THE CONTROL POINT.*/* A PLOT FOR FREQUENCY OF OCCURRENCE VS DISCRE     923
     4PANCY FOLLOWS AS PART OF THIS LISTING*//////)                          924
      REWIND 7                                                               925
      YMAX=FLOAT(KORN(1))-FLOAT(KM-1)*DIST                                   926
      XMIN=FLOAT(KORE(1))                                                    927
      ICNT=0                                                                 928
      I1=0                                                                   929
      DO 100 L=1,LM                                                          930
      XTAB(L)=XMIN+DIST*(FLOAT(L-1))                                         931
      I1=(60)*(L-1)                                                          932
      I2=I1+KM+1                                                             933
      DO 100 J=1,KM                                                          934
      IF (L.EQ.1) ZTAB(J)=YMAX+DIST*FLOAT(J-1)                               935
      I1=I2-J                                                                936
      YTAB(I1)=I(J,L)                                                        937
  100 CONTINUE                                                               938
      LM1=LM+1                                                               939
      KM1=KM+1                                                               940
      DO 101 N=KM1,60                                                        941
      ZTAB(N)=ZTAB(KM)+DIST*(N-KM)                                           942
      DO 101 J=1,LM                                                          943
      K=(J-1)*(60)+KM                                                        944
  101 YYTAB(N,J)=YTAB(K)                                                     945
      DO 102 N=1,KM                                                          946
      K=(LM-1)*(60)+N                                                        947
      DO 102 J=LM1,60                                                        948
      XTAB(J)=XTAB(LM)+DIST*(J-LM)                                           949
  102 YYTAB(N,J)=YTAB(K)                                                     950
  200 CONTINUE                                                               951
      CALL RECIN(7,1,KKK,ICODE,IX,IY,IZ,IDIST)                               952
      IF (EOF(7))201,202                                                     953
  202 IF(ICODE.GT.0) GO TO 201                                               954
      XA=IX                                                                  955
      ZA=IY                                                                  956
      CALL DISCOT(ZA,XA,ZTAB,YTAB,XTAB,111,3600,60,ANS)                      957
      ANS=ANS-FLOAT(IADDI)                                                   958
      ICNT=ICNT+1                                                            959
      ARG(ICNT,1)=IZ/(1000.0)                                                960
      ARG(ICNT,2)=ANS/(1000.0)                                               961
      GO TO 200                                                              962
  201 CONTINUE                                                               963
      CALL SUB1(ARG,ICNT)                                                    964
      RETURN                                                                 965
      END                                                                    966
      SUBROUTINE SUB1(ARG, NOPT)                                             967
      DIMENSION ARG(1000,2),CLASS2(201),DIFF(1000)                           968
      DIMENSION CLASS(201),COUNT(201),PERCENT(201),IN(2)                     969
      DIMENSION IORD(11),IABSC(201),LORD(201),ABSC(201),  XM(2),YM1(3)       970
      ITAPE=5LTAPE7                                                          971
      CNTMX=-200.0                                                           972
      REWIND 7                                                               973
      SUM=SUMSQ=B1=B2=0.0                                                    974
      ISUM=0                                                                 975
      DO 20 I=1,200                                                          976
   20 CLASS(I)=(I-101)*(0.02)+0.01                                           977
      DO 40 I=1,201                                                          978
   40 COUNT(I)=0                                                             979
      DO 130 J=1,NOPT                                                        980
      IF (ARG(J,1).EQ.1000000.0.OR.ARG(J,2).EQ.1000000.0) GO TO130           981
      DIFFER=ARG(J,2)-ARG(J,1)                                               982
      SUM=SUM+DIFFER                                                         983
      ISUM=ISUM+1                                                            984
      SUMSQ=SUMSQ+DIFFER**2                                                  985
      N=J+1                                                                  986
      IF(J.EQ.NOPT)GO TO 45                                                  987
      DO 30 I=N,NOPT                                                         988
      IF (ARG(I,1).EQ.1000000.0.OR.ARG(I,2).EQ.1000000.0) GO TO 30           989
      DARG1=ARG(I,1)-ARG(J,1)                                                990
      DARG2=ARG(I,2)-ARG(J,2)                                                991
      DELARG=DARG2-DARG1                                                     992
   30 CONTINUE                                                               993
  130 CONTINUE                                                               994
   45 CONTINUE                                                               995
      AV=SUM/FLOAT(ISUM)                                                     996
      SIGMASQ=SUMSQ/FLOAT(ISUM)-AV**2                                        997
      DO 75 I=1,200                                                          998
      COUNT(I)=0                                                             999
   75 CLASS2(I)=(I-101)*(0.02)+0.01                                         1000
      DO 131 J=1,NOPT                                                       1001
      IF (ARG(J,1).EQ.1000000.0.OR.ARG(J,2).EQ.1000000.0) GO TO131          1002
      DIFFER=ARG(J,2)-ARG(J,1)                                              1003
      B1=B1+(DIFFER-AV)**3                                                  1004
      B2=B2+(DIFFER-AV)**4                                                  1005
      DIFF(J)=DIFFER-AV                                                     1006
      DO 77 I=1,199                                                         1007
      IF(DIFF(J).GE.CLASS2(I).AND.DIFF(J).LE.CLASS2(I+1))GO TO 78           1008
   77 CONTINUE                                                              1009
      GO TO 79                                                              1010
   78 COUNT(I+1)=COUNT(I+1)+1.0                                             1011
   79 CONTINUE                                                              1012
  131 CONTINUE                                                              1013
      DO 80 I=1,200                                                         1014
      IF (COUNT(I).GT.CNTMX) CNTMX=COUNT(I)                                 1015
   80 CLASS2(I)=(CLASS2(I)+0.01)*1000.0                                     1016
      ISCALE=IFIX(CNTMX)/100+1                                              1017
      JLAST=0$JMAX=0                                                        1018
      DO 70 I=1,200                                                         1019
      IABSC(I)=CLASS2(I)                                                    1020
      LORD(I)=IFIX(COUNT(I)/FLOAT(ISCALE))                                  1021
      IF (LORD(I).GT.0) JMAX=JMAX+1                                         1022
      IF (I.LE.11) IORD(I)=I-1                                              1023
      IF (I.LT.96.OR.I.GT.106) ABSC(I)=2H                                   1024
   70 CONTINUE                                                              1025
      ABSC( 96)=2H D                                                        1026
      ABSC( 97)=2H I                                                        1027
      ABSC(98 )=2H S                                                        1028
      ABSC(99 )=2H C                                                        1029
      ABSC(100)=2H R                                                        1030
      ABSC(101)=2H E                                                        1031
      ABSC(102)=2H P                                                        1032
      ABSC(103)=2H A                                                        1033
      ABSC(104)=2H N                                                        1034
      ABSC(105)=2H C                                                        1035
      ABSC(106)=2H Y                                                        1036
      ISTART=10H                                                            1037
      IEND=ISCALE*10                                                        1038
      PRINT 301,(IORD(I),I=1,11),IEND                                       1039
  301 FORMAT(52X,*FREQUENCY OF OCCURRENCE*/,3X,11I10,*X*I4*  NUMBER*)       1040
      ISYMB=1H*                                                             1041
      ISYMB1=1H                                                             1042
      DO 200 I=1,200                                                        1043
      J=LORD(I)                                                             1044
      JO=IFIX(COUNT(I))                                                     1045
      IF (J.GT.0.AND.JLAST.EQ.0) JLAST=1                                    1046
      IF (J.EQ.0) GO TO 303                                                 1047
      JMAX=JMAX-1                                                           1048
      JJ=J+1                                                                1049
      PRINT300,ABSC(I),IABSC(I),(ISYMB,K=1,J),(ISYMB1,JK=JJ,100)            1050
  300 FORMAT(1H+,A2,I10,112A1)                                              1051
      GO TO 304                                                             1052
  303 CONTINUE                                                              1053
      IF (JLAST.EQ.0.OR.JMAX.LE.0) GO TO 200                                1054
      PRINT 300,ABSC(I),IABSC(I)                                            1055
  304 CONTINUE                                                              1056
      PRINT 302,JO                                                          1057
  302 FORMAT(115X,I10)                                                      1058
  200 CONTINUE                                                              1059
      PRINT 2,AV,SIGMASQ                                                    1060
    2 FORMAT(* ALL CONTROL POINTS HAVE BEEN COMPARED AND THE RESULTS ARE    1061
     1 SHOWN*/* IT WAS DETERMINED FROM THE COMPARISONS THAT THERE WAS A*    1062
     2/* MEAN DIFFERENCE =*E16.8,/* AND A*/* ST DEV =*E16.8,  /,* THE DE    1063
     3PTH MATRIX WILL NOW BE PLOTTED*/* A TWO DIMENSIONAL CONTOUR CHART     1064
     4WILL BE PREPARED WITH A SUITABLE GRID*/* EACH GRID LINE REPRESENTS    1065
     5 AN INTEGRAL MULTIPLE OF DISPGRD(SEE INPUT INSTRUCTIONS) */* AND T    1066
     6HE CONTOURS ARE POSITIONED RELATIVE TO THIS GRID*/* PLOTTING BEGIN    1067
     7S WITH THE UPPER LEFT HAND CORNER OF THE DEPTH MATRIX*/)              1068
      RETURN                                                                1069
      END                                                                   1070
      OVERLAY (LINK,3,2)                                                    1071
      PROGRAM AUTO CON                                                      1072
      REAL      MINWRD2,MAXWRD2,MINWRD3,MAXWRD3                             1073
      DIMENSION IDEPH(160,3)                                                1074
      DIMENSION DEPTH(17,17)                                                1075
      DIMENSION IEL(60,60)                                                  1076
      COMMON /BLK1/ IEL                                                     1077
      COMMON /BLK3/ MAT,MIT                                                 1078
      COMMON /BLK5/ MINWRD2,MAXWRD2,MINWRD3,MAXWRD3                         1079
      COMMON /BLK6/ SP,SPP,LAST,AP     , LINEUNT                            1080
      COMMON /BLK7/ N,NN,PX1,PY1,XMAX,YMAX,XMAY,YMAY,CI                     1081
      COMMON /BLK8/ SQX,SQY                                                 1082
      COMMON /BLK9/ POS1X(20),POS1Y(20),CONT (20)                           1083
      COMMON /BLK10/POS2X(20),POS2Y(20),CONTA(20)                           1084
      COMMON /BLK11/POS3X(20),POS3Y(20),CONTB(20)                           1085
      COMMON /BLK12/POS4X(20),POS4Y(20),CONTC(20)                           1086
      COMMON /BLK13/POS5X(20),POS5Y(20),CONTD(20)                           1087
      COMMON /LINKDC/ LINK,RECALL                                           1088
      CALL CALCOMP                                                          1089
      CALL LEROY                                                            1090
      MINWRD2=MINWRD2/FLOAT(LINEUNT)                                        1091
      MINWRD3=MINWRD3/FLOAT(LINEUNT)                                        1092
      MAXWRD2=MAXWRD2/FLOAT(LINEUNT)                                        1093
      MAXWRD3=MAXWRD3/FLOAT(LINEUNT)                                        1094
      DO 9913 I=1,3                                                         1095
      DO 9913 J=1,160                                                       1096
 9913 IDEPH(J,I)=0                                                          1097
      DO 9914 I=1,17                                                        1098
      DO 9914 J=1,17                                                        1099
 9914 DEPTH(I,J)=0.0                                                        1100
 1000 CONTINUE                                                              1101
      Y20=(MAXWRD2-FLOAT(IFIX(MAXWRD2)))                                    1102
      X20=(MINWRD3-FLOAT(IFIX(MINWRD3)))                                    1103
      IF (Y20.GT.0.0) Y20=1.0-Y20                                           1104
      IF (Y20.LT.0.0) Y20=ABS(Y20)                                          1105
      IF (X20.LT.0.0) X20=X20+1                                             1106
      Y20=Y20*AP                                                            1107
      X20=X20*AP                                                            1108
      ILINE=IFIX(MAXWRD3)-IFIX(MINWRD3)                                     1109
      JLINE=IFIX(MAXWRD2)-IFIX(MINWRD2)                                     1110
      LINE CNT=0                                                            1111
  258 IF(Y20+( MAXWRD2-MINWRD2-FLOAT(JLINE))*AP+0.5.GE.0.0) JLINE=JLINE+    1112
     11                                                                     1113
      IF (Y20+(MAXWRD3-MINWRD3-FLOAT(ILINE))*AP+0.5.GE.0.0) ILINE=ILINE+    1114
     11                                                                     1115
      LINECNT=LINECNT+1                                                     1116
      IF (LINECNT.LT.2) GO TO 258                                           1117
      X10=0.0                                                               1118
      IF (X20-0.4.LE.0.0) X10=X10-AP                                        1119
      IF (X20-0.4.LE.0.0) ILINE=ILINE+1                                     1120
      Y10=-FLOAT(JLINE)*AP                                                  1121
      CALL GRID (X10,Y10,AP,AP,ILINE,JLINE)                                 1122
      DV=1.0/AP                                                             1123
      ORIGIN=FLOAT(IFIX(MINWRD3))                                           1124
      IF (X20-0.4.LE.0.0) ORIGIN=ORIGIN-DV*AP                               1125
      XDIST=ILINE*AP                                                        1126
      YDIST=JLINE*AP                                                        1127
      CALL AXES(X10,Y10,0.0,XDIST,ORIGIN,DV,AP,DV,1H ,0.1,-1)               1128
      ORIGIN=FLOAT(IFIX(MAXWRD2))-FLOAT(JLINE)                              1129
      CALL AXES(X10,Y10,90.,YDIST,ORIGIN,DV,AP,DV,1H ,0.1,+1)               1130
      Y20=Y20*(-1.0)                                                        1131
      CALL CALPLT (X20,Y20,-3)                                              1132
 9942 CONTINUE                                                              1133
      XMAT=FLOAT((MIT-1)/2)*SP*2                                            1134
      XMAX=XMAT                                                             1135
      XMAY=-XMAX                                                            1136
      YMAX=FLOAT((MAT-1)/2)*SP*(2.0 )                                       1137
      YMAX=YMAX+0.05                                                        1138
      YMAY=-YMAX                                                            1139
      PY1=0.0                                                               1140
      PX1=0.0                                                               1141
      SP=SP/SPP                                                             1142
      SQX=SP                                                                1143
      SQY=-SP                                                               1144
      SPX=SP                                                                1145
      SPY=-SP                                                               1146
      IF (MIT.LT.20) NOC=1                                                  1147
      IF (MIT.EQ.(MIT/20)*20) NOC=MIT/20                                    1148
      IF (MIT.GT.(MIT/20)*20) NOC=MIT/20+1                                  1149
   21 K=0                                                                   1150
      KK=0                                                                  1151
      NX=NOC*20                                                             1152
      IS=SPP                                                                1153
  850 K=K+1                                                                 1154
      IF (KK) 8850,8851,8850                                                1155
 8850 JJ=K-1                                                                1156
      JK=K+1                                                                1157
      DO 8852 I=1,MIT                                                       1158
      IDEPH(I,JJ)=IDEPH(I,JK)                                               1159
 8852 CONTINUE                                                              1160
 8851 CONTINUE                                                              1161
  779 CONTINUE                                                              1162
      IF (KK-MAT) 9779,812,812                                              1163
 9779 CONTINUE                                                              1164
      KKK=KK+1                                                              1165
      DO 9933 J=1,MIT                                                       1166
      IDEPH(J,K)=IEL(KKK,J)                                                 1167
 9933 CONTINUE                                                              1168
  780 KK=KK+1                                                               1169
  782 IF (K-3)9850,784,784                                                  1170
 9850 K=K+1                                                                 1171
      GO TO 8851                                                            1172
  784 J=1                                                                   1173
      K=1                                                                   1174
  698 IX=1                                                                  1175
      IY=1                                                                  1176
      L=1                                                                   1177
      LL=L+IS                                                               1178
      LLL=LL+IS                                                             1179
      M=1                                                                   1180
      MM=M+IS                                                               1181
      MMM=MM+IS                                                             1182
      K=1                                                                   1183
  699 DEPTH(L,M)=IDEPH(J,K)                                                 1184
  700 IF (IDEPH(J+1,K))3,4,3                                                1185
    3 IF (IDEPH(J,K))5,4,5                                                  1186
    4 IF (J.LE.MIT.AND.IDEPH(J,K).NE.0) GO TO 5                             1187
      SQX=SQX+((2.0)*SPP*SP)                                                1188
      IF (J-1)6,6,7                                                         1189
    7 JCK1=J/2                                                              1190
      JCK2=JCK1*2                                                           1191
      IF (J-JCK2)8,9,8                                                      1192
    8 J=J+2                                                                 1193
      GO TO 10                                                              1194
    9 J=J+1                                                                 1195
      GO TO 10                                                              1196
    6 J=3                                                                   1197
   10 JC=JC+2                                                               1198
      IF (JC-NX+1) 698,1851,1851                                            1199
 1851 SQY=SQY-((2.0)*SPP*SP)                                                1200
      K=1                                                                   1201
      SQX=SPX                                                               1202
      GO TO 1852                                                            1203
    5 XINC1=IDEPH(J+1,K)-IDEPH(J,K)                                         1204
      XINC1=XINC1/SPP                                                       1205
      XINC=ABS(XINC1)                                                       1206
  703 L=L+1                                                                 1207
      IF (L-LL) 704,705,706                                                 1208
  704 IF (XINC1) 701,701,702                                                1209
  701 DEPTH(L,M)=DEPTH(L-1,M)-XINC                                          1210
      GO TO 703                                                             1211
  702 DEPTH(L,M)=DEPTH(L-1,M)+XINC                                          1212
      GO TO 703                                                             1213
  705 J=J+1                                                                 1214
      LL=LLL                                                                1215
      IF (L-LLL) 699,699,706                                                1216
  706 JC=J                                                                  1217
      J=J-2                                                                 1218
      L=1                                                                   1219
      K=K+1                                                                 1220
      M=M+IS                                                                1221
      IF (M-MMM) 707,707,708                                                1222
  707 LL=L+IS                                                               1223
      GO TO 699                                                             1224
  708 KC=K-1                                                                1225
      L=1                                                                   1226
      M=1                                                                   1227
      LL=L+IS                                                               1228
  798 YINC1=DEPTH(L,MM)-DEPTH(L,M)                                          1229
      YINC1=YINC1/SPP                                                       1230
      YINC=ABS(YINC1)                                                       1231
 1803 M=M+1                                                                 1232
      IF (M-MM) 1804,1805,1806                                              1233
 1804 IF (YINC1) 1801,1801,1802                                             1234
 1801 DEPTH(L,M)=DEPTH(L,M-1)-YINC                                          1235
      GO TO 1803                                                            1236
 1802 DEPTH(L,M)=DEPTH(L,M-1)+YINC                                          1237
      GO TO 1803                                                            1238
 1805 L=L+1                                                                 1239
      M=M-IS                                                                1240
      IF (L-LLL) 798,798,799                                                1241
  799 M=MM                                                                  1242
      MM=MMM                                                                1243
      L=1                                                                   1244
      GO TO 798                                                             1245
 1806 J=JC                                                                  1246
      INDEX=1                                                               1247
      M2=2                                                                  1248
      L2=2                                                                  1249
      L1=2                                                                  1250
      K1=2                                                                  1251
      J1=1                                                                  1252
      J2=1                                                                  1253
      K2=1                                                                  1254
      M1=1                                                                  1255
  100 CONTINUE                                                              1256
      DO 9912 I=1,20                                                        1257
      CONT(I)=0.0                                                           1258
      CONTA(I)=0.0                                                          1259
      CONTB(I)=0.0                                                          1260
      CONTC(I)=0.0                                                          1261
      CONTD(I)=0.0                                                          1262
      POS1X(I)=0.0                                                          1263
      POS2X(I)=0.0                                                          1264
      POS3X(I)=0.0                                                          1265
      POS4X(I)=0.0                                                          1266
      POS5X(I)=0.0                                                          1267
      POS1Y(I)=0.0                                                          1268
      POS2Y(I)=0.0                                                          1269
      POS3Y(I)=0.0                                                          1270
      POS4Y(I)=0.0                                                          1271
      POS5Y(I)=0.0                                                          1272
 9912 CONTINUE                                                              1273
      I=1                                                                   1274
      II=1                                                                  1275
      III=1                                                                 1276
      I4=1                                                                  1277
      I5=1                                                                  1278
      CALL LINE1 (DEPTH(L1,L2),DEPTH(M1,M2),CI,INDEX,I  ,D1)                1279
      CALL LINE2 (DEPTH(M1,M2),DEPTH(J1,J2),CI,INDEX,II ,D2)                1280
      CALL LINE3 (DEPTH(L1,L2),DEPTH(J1,J2),CI,INDEX,III,D3)                1281
      CALL LINE4 (DEPTH(J1,J2),DEPTH(K1,K2),CI,INDEX,I4 ,D4)                1282
      CALL LINE5 (DEPTH(L1,L2),DEPTH(K1,K2),CI,INDEX,I5 ,D5)                1283
      IF (D1) 101,103,103                                                   1284
  101 IF (D2) 133,114,114                                                   1285
  114 N=1                                                                   1286
      NN=1                                                                  1287
  134 IF (CONT(N)-CONTA(NN)) 131,132,133                                    1288
  131 N=N+1                                                                 1289
      IF (CONT(N))134,133,134                                               1290
  132 IF (CONT(N))1132,133,1132                                             1291
 1132 CALL PLOT (POS2X(NN),POS2Y(NN),POS1X(N),POS1Y(N),POS2X(NN),           1292
     1 POS2Y(NN),CONTA(NN),+1)                                              1293
      IF (N) 133,133,1134                                                   1294
 1134 IF (CONTA(NN))134,133,134                                             1295
  133 IF (D3) 338,140,140                                                   1296
  140 N=1                                                                   1297
      NN=1                                                                  1298
  153 IF (CONTB(N)-CONTA(NN))149,150,138                                    1299
  149 IF (CONTB(N)) 152,138,152                                             1300
  152 NN=NN+1                                                               1301
      IF (CONTA(NN)) 153,138,153                                            1302
  150 IF (CONTB(N)) 1150,138,1150                                           1303
 1150 CALL PLOT (POS3X(N),POS3Y(N),POS2X(NN),POS2Y(NN),POS2X(NN),           1304
     1 POS2Y(NN),CONTA(NN),-1)                                              1305
      GO TO 153                                                             1306
  338 N=1                                                                   1307
      NN=1                                                                  1308
  350 IF (CONTB(N)-CONTA(NN)) 349,348,349                                   1309
  349 N=N+1                                                                 1310
      IF (CONTB(N)) 350,538,350                                             1311
  348 IF (CONTB(N)) 1348,538,1348                                           1312
 1348 CALL PLOT (POS2X(NN),POS2Y(NN),POS3X(N ),POS3Y(N ),POS2X(NN),         1313
     1 POS2Y(NN),CONTA(NN),-1)                                              1314
      IF (CONTB(N)) 350,538,350                                             1315
  538 N=1                                                                   1316
      NN=1                                                                  1317
  542 IF (CONT(N)-CONTB(NN))138,540,138                                     1318
  540 IF (CONT(N)) 539,138,539                                              1319
  539 IF (CONTB(NN)) 541,138,541                                            1320
  541 CALL CALPLT (POS1X(N),POS1Y(N),3)                                     1321
      CALL CALPLT (POS3X(NN),POS3Y(NN),2)                                   1322
      N=N+1                                                                 1323
      NN=NN+1                                                               1324
      GO TO 542                                                             1325
  103 IF (D2) 162,181,181                                                   1326
  162 N=1                                                                   1327
      NN=1                                                                  1328
  184 IF (CONT(N)-CONTA(NN)) 181,182,183                                    1329
  183 N=N+1                                                                 1330
      IF (CONT(N)) 184,181,184                                              1331
  182 IF (CONT(N)) 1182,181,1182                                            1332
 1182 CALL PLOT (POS1X(N),POS1Y(N),POS2X(NN),POS2Y(NN),POS2X(NN),           1333
     1 POS2Y(NN),CONTA(NN),+1)                                              1334
      IF (N) 181,181,1184                                                   1335
 1184 IF (CONTA(NN))184,181,184                                             1336
  181 IF (D3) 187,438,438                                                   1337
  187 N=1                                                                   1338
      NN=1                                                                  1339
  200 IF (CONTB(N)-CONTA(NN))138,198,199                                    1340
  199 NN=NN+1                                                               1341
      IF (CONTA(NN)) 200,138,200                                            1342
  198 IF (CONTB(N)) 1198,138,1198                                           1343
 1198 CALL PLOT (POS3X(N),POS3Y(N),POS2X(NN),POS2Y(NN),POS2X(NN),           1344
     1 POS2Y(NN),CONTA(NN),-1)                                              1345
      IF (CONTB(N)) 200,138,200                                             1346
  438 N=1                                                                   1347
      NN=1                                                                  1348
  450 IF (CONTB(N)-CONTA(NN)) 538,448,449                                   1349
  449 N=N+1                                                                 1350
      IF (CONTB(N)) 450,538,450                                             1351
  448 IF (CONTB(N)) 1448,538,1448                                           1352
 1448 CALL PLOT (POS2X(NN),POS2Y(NN),POS3X(N ),POS3Y(N ),POS2X(NN),         1353
     1 POS2Y(NN),CONTA(NN),-1)                                              1354
      IF (CONTB(N))450,538,450                                              1355
  138 IF (D3) 201,203,203                                                   1356
  201 IF (D4) 227,206,206                                                   1357
  206 N=1                                                                   1358
      NN=1                                                                  1359
  226 IF (CONTB(N)-CONTC(NN)) 223,224,227                                   1360
  223 N=N+1                                                                 1361
      IF (CONTB(N)) 226,227,226                                             1362
  224 IF (CONTB(N)) 1224,227,1224                                           1363
 1224 CALL PLOT (POS4X(NN),POS4Y(NN),POS3X(N),POS3Y(N),POS4X(NN),           1364
     1 POS4Y(NN),CONTC(NN),+1)                                              1365
      IF (N) 227,227,2226                                                   1366
  227 IF (D5) 228,230,230                                                   1367
  230 N=1                                                                   1368
      NN=1                                                                  1369
  242 IF (CONTD(N)-CONTC(NN)) 239,240,241                                   1370
  239 NN=NN+1                                                               1371
      IF (CONTC(NN)) 242,243,242                                            1372
  240 IF (CONTD(N)) 1240,243,1240                                           1373
 1240 CALL PLOT (POS5X(N),POS5Y(N),POS4X(NN),POS4Y(NN),POS4X(NN),           1374
     1 POS4Y(NN),CONTC(NN),-1)                                              1375
      IF (CONTC(NN)) 242,243,242                                            1376
  228 N=1                                                                   1377
      NN=1                                                                  1378
  255 IF (CONTD(N)-CONTC(NN)) 1252,253,241                                  1379
  252 N=N+1                                                                 1380
      IF (CONTD(N)) 255,241,255                                             1381
  253 IF (CONTD(N)) 1253,241,1253                                           1382
 1253 CALL PLOT (POS5X(N),POS5Y(N),POS4X(NN),POS4Y(NN),POS4X(NN),           1383
     1 POS4Y(NN),CONTC(NN),-1)                                              1384
      IF (CONTC(NN)) 255,241,255                                            1385
 1252 IF (CONTD(N)) 252,241,252                                             1386
  241 N=1                                                                   1387
      NN=1                                                                  1388
  543 IF (CONTB(N)-CONTD(NN)) 243,544,243                                   1389
  544 IF (CONTB(N)) 545,243,545                                             1390
  545 IF (CONTD(NN)) 546,243,546                                            1391
  546 CALL CALPLT (POS3X(N),POS3Y(N),3)                                     1392
      CALL CALPLT (POS5X(NN),POS5Y(NN),2)                                   1393
      N=N+1                                                                 1394
      NN=NN+1                                                               1395
      GO TO 543                                                             1396
  203 IF (D4) 256,275,275                                                   1397
  256 N=1                                                                   1398
      NN=1                                                                  1399
 1274 IF (CONTB(N)-CONTC(NN)) 275,276,277                                   1400
  277 N=N+1                                                                 1401
      IF (CONTB(N)) 1274,275,1274                                           1402
  276 IF (CONTB(N))1276,275,1276                                            1403
 1276 CALL PLOT (POS4X(NN),POS4Y(NN),POS3X(N),POS3Y(N),POS4X(NN),           1404
     1 POS4Y(NN),CONTC(NN),+1)                                              1405
      IF (N)  275,275,1274                                                  1406
  275 CONTINUE                                                              1407
      IF (D5) 278,280,280                                                   1408
  278 N=1                                                                   1409
      NN=1                                                                  1410
  291 IF (CONTD(N)-CONTC(NN)) 243,289,290                                   1411
  290 NN=NN+1                                                               1412
      IF (CONTC(NN)) 291,243,291                                            1413
  289 IF (CONTD(N)) 1289,243,1289                                           1414
 1289 CALL PLOT (POS5X(N),POS5Y(N),POS4X(NN),POS4Y(NN),POS4X(NN),           1415
     1 POS4Y(NN),CONTC(NN),-1)                                              1416
      IF (CONTC(NN)) 291,243,291                                            1417
  280 N=1                                                                   1418
      NN=1                                                                  1419
  302 IF (CONTD(N)-CONTC(NN)) 241,300,301                                   1420
  301 N=N+1                                                                 1421
      IF (CONTD(N)) 302,241,302                                             1422
  300 IF (CONTD(N)) 1300,241,1300                                           1423
 1300 CALL PLOT (POS5X(N),POS5Y(N),POS4X(NN),POS4Y(NN),POS4X(NN),           1424
     1 POS4Y(NN),CONTC(NN),-1)                                              1425
      IF (CONTD(NN)) 302,241,302                                            1426
  243 INDEX=INDEX+1                                                         1427
      IF (INDEX-4) 800,800,801                                              1428
  800 GO TO (804,805,806,807) ,INDEX                                        1429
  804 J1=J1+2                                                               1430
      J2=J2-2                                                               1431
      K1=K1+3                                                               1432
      K2=K2-1                                                               1433
      L1=L1+2                                                               1434
      M1=M1+1                                                               1435
      M2=M2-1                                                               1436
      GO TO 808                                                             1437
  805 J1=J1+2                                                               1438
      K1=K1+1                                                               1439
      K2=K2+1                                                               1440
      M1=M1+1                                                               1441
      M2=M2-1                                                               1442
      GO TO 100                                                             1443
  806 J2=J2+2                                                               1444
      K1=K1-1                                                               1445
      K2=K2+1                                                               1446
      M1=M1+1                                                               1447
      M2=M2+1                                                               1448
      GO TO 100                                                             1449
  807 J1=J1-2                                                               1450
      K1=K1-1                                                               1451
      K2=K2-1                                                               1452
      M1=M1-1                                                               1453
      M2=M2+1                                                               1454
      GO TO 100                                                             1455
  801 IX=IX+1                                                               1456
      IF (IX-IS) 809,809,810                                                1457
  809 INDEX=1                                                               1458
      GO TO 804                                                             1459
  808 SQX=SQX+(2.0*SPX)                                                     1460
      GO TO 100                                                             1461
  810 IY=IY+1                                                               1462
      IF (IY-IS) 2811,2811,2812                                             1463
 2811 SQX=SQX-(2.0*(SPP-1.0)*SPX)                                           1464
      SQY=SQY+(2.0*SPY)                                                     1465
      J1=1                                                                  1466
      K1=2                                                                  1467
      K2=K2+1                                                               1468
      L1=2                                                                  1469
      L2=L2+2                                                               1470
      M1=1                                                                  1471
      M2=M2+1                                                               1472
      IX=1                                                                  1473
  811 INDEX=1                                                               1474
      GO TO 100                                                             1475
 2812 SQX=SQX+(2.0*SPX)                                                     1476
      SQY=SQY-(2.0*(SPP-1.0)*SPY)                                           1477
      IF (JC-NX+1) 698,851,851                                              1478
  851 K=1                                                                   1479
      SQX=SPX                                                               1480
      SQY=SQY+(2.0*SPP*SPY)                                                 1481
 1852 CONTINUE                                                              1482
 1008 FORMAT (2F10.5,I5)                                                    1483
      JC=1                                                                  1484
      GO TO 850                                                             1485
 2226 IF (CONTC(NN)) 226,227,226                                            1486
  812 IF (LAST) 1001,1003,1001                                              1487
 1003 CONTINUE                                                              1488
 9941 CALL CALPLT(24.0,0.0,-3)                                              1489
      GO TO 9942                                                            1490
 1001 WRITE (6,1002)                                                        1491
 1002 FORMAT (5H END  )                                                     1492
      CALL CALPLT (0.0,0.0,999)                                             1493
      RETURN                                                                1494
      END                                                                   1495
      SUBROUTINE LINE1 (DEPTHL,DEPTHM,CI,INDEX,I  ,D1)                      1496
      COMMON /BLK6/ SP                                                      1497
      COMMON /BLK8/ SQX,SQY                                                 1498
      COMMON /BLK9/ POS1X(20),POS1Y(20),CONT (20)                           1499
      D1=DEPTHL-DEPTHM                                                      1500
      KX=DEPTHL/CI                                                          1501
      SX=KX                                                                 1502
      IF (D1.LT.0) CONT (I  )=SX*CI+CI                                      1503
      IF (D1.GE.0) CONT (I  )=SX*CI                                         1504
  104 CONTINUE                                                              1505
      IF (D1) 1,2,2                                                         1506
    1 CONTINUE                                                              1507
      IF (CONT(I)-DEPTHM.LE.0.0.AND.D1.LT.0.0) 105,106                      1508
    2 CONTINUE                                                              1509
      IF (CONT(I)-DEPTHM.LT.0.0.AND.D1.GE.0.0) 106,105                      1510
  105 IF (D1.LT.0) DC=CONT (I  )-DEPTHL                                     1511
      IF (D1.GE.0) DC=DEPTHL-CONT (I  )                                     1512
      IF (D1.EQ.0.0) D1=0.000000001                                         1513
      GO TO (107,108,109,110),INDEX                                         1514
  107 POS1X(I)=SQX-((DC/ABS(D1))*SP)                                        1515
      POS1Y(I)=SQY                                                          1516
  111 I=I+1                                                                 1517
      IF(I  .GT.20) PRINT 500                                               1518
C     IF (I.GT.20) B=(FOUR/0.0)**2                                          1519
  500 FORMAT(1H1* CONTOUR IS TOO SMALL*/)                                   1520
      IF (D1.LT.0.0) CONT (I  )=CONT (I  -1)+CI                             1521
      IF (D1.GE.0.0) CONT (I  )=CONT (I  -1)-CI                             1522
      GO TO 104                                                             1523
  108 POS1Y(I)=SQY+((DC/ABS(D1))*SP)                                        1524
      POS1X(I)=SQX                                                          1525
      GO TO 111                                                             1526
  109 POS1X(I)=SQX+((DC/ABS(D1))*SP)                                        1527
      POS1Y(I)=SQY                                                          1528
      GO TO 111                                                             1529
  110 POS1X(I)=SQX                                                          1530
      POS1Y(I)=SQY-((DC/ABS(D1))*SP)                                        1531
      GO TO 111                                                             1532
  106 CONT(I)=0.0                                                           1533
      RETURN                                                                1534
      END                                                                   1535
      SUBROUTINE LINE2 (DEPTHM,DEPTHJ,CI,INDEX,II ,D2)                      1536
      COMMON /BLK6/ SP                                                      1537
      COMMON /BLK8/ SQX,SQY                                                 1538
      COMMON /BLK10/POS2X(20),POS2Y(20),CONTA(20)                           1539
      D2=DEPTHM-DEPTHJ                                                      1540
      KX=DEPTHM/CI                                                          1541
      SX=KX                                                                 1542
      IF (D2.LT.0) CONTA(II )=SX*CI+CI                                      1543
      IF (D2.GE.0) CONTA(II )=SX*CI                                         1544
  115 CONTINUE                                                              1545
      IF (D2) 1,2,2                                                         1546
    1 CONTINUE                                                              1547
      IF (CONTA(II)-DEPTHJ.LE.0.AND.D2.LT.0) 116,117                        1548
    2 CONTINUE                                                              1549
      IF (CONTA(II)-DEPTHJ.LT.0.AND.D2.GE.0) 117,116                        1550
  116 IF (D2.LT.0) DC=CONTA(II )-DEPTHM                                     1551
      IF (D2.GE.0) DC=DEPTHM-CONTA(II)                                      1552
      IF (D2.EQ.0.0) D2=0.000000001                                         1553
      GO TO (118,119,120,121) ,INDEX                                        1554
  118 POS2X(II)=SQX-SP                                                      1555
      POS2Y(II)=SQY+((DC/ABS(D2))*SP)                                       1556
  122 II=II+1                                                               1557
C     IF(II.GT.20) B=(FOUR/0.0)**2                                          1558
      IF(II .GT.20) PRINT 500                                               1559
  500 FORMAT(* CONTOUR INTERVAL IS TOO SMALL*/)                             1560
      IF (D2.LT.0.0) CONTA(II )=CONTA(II -1)+CI                             1561
      IF (D2.GE.0.0) CONTA(II )=CONTA(II -1)-CI                             1562
      GO TO 115                                                             1563
  119 POS2X(II)=SQX+((DC/ABS(D2))*SP)                                       1564
      POS2Y(II)=SQY+SP                                                      1565
      GO TO 122                                                             1566
  120 POS2X(II)=SQX+SP                                                      1567
      POS2Y(II)=SQY-((DC/ABS(D2))*SP)                                       1568
      GO TO 122                                                             1569
  121 POS2X(II)=SQX-((DC/ABS(D2))*SP)                                       1570
      POS2Y(II)=SQY-SP                                                      1571
      GO TO 122                                                             1572
  117 CONTA(II)=0.0                                                         1573
      RETURN                                                                1574
      END                                                                   1575
      SUBROUTINE LINE3 (DEPTHL,DEPTHJ,CI,INDEX,III,D3)                      1576
      COMMON /BLK6/ SP                                                      1577
      COMMON /BLK8/ SQX,SQY                                                 1578
      COMMON /BLK11/POS3X(20),POS3Y(20),CONTB(20)                           1579
      D3=DEPTHL-DEPTHJ                                                      1580
      KX=DEPTHL/CI                                                          1581
      SX=KX                                                                 1582
      IF (D3.LT.0) CONTB(III)=SX*CI+CI                                      1583
      IF (D3.GE.0) CONTB(III)=SX*CI                                         1584
  341 CONTINUE                                                              1585
      IF (D3) 1,2,2                                                         1586
    1 CONTINUE                                                              1587
      IF (CONTB(III)-DEPTHJ.LE.0.0.AND.D3.LT.0.0)339,340                    1588
    2 CONTINUE                                                              1589
      IF (CONTB(III)-DEPTHJ.LT.0.0.AND.D3.GE.0.0)340,339                    1590
  339 IF (D3.LT.0) DC=CONTB(III)-DEPTHL                                     1591
      IF (D3.GE.0) DC=DEPTHL-CONTB(III)                                     1592
      IF (D3.EQ.0.0) D3=0.000000001                                         1593
      GO TO (342,343,344,345) ,INDEX                                        1594
  342 POS3X(III)=SQX-((DC/ABS(D3))*SP)                                      1595
      POS3Y(III)=SQY+((DC/ABS(D3))*SP)                                      1596
  346 III=III+1                                                             1597
      IF(III.GT.20) PRINT 500                                               1598
C     IF(III.GT.20) B=(FOUR/0.0)**2                                         1599
  500 FORMAT(* CONTOUR INTERVAL IS TOO SMALL*/)                             1600
      IF (D3.LT.0.0) CONTB(III)=CONTB(III-1)+CI                             1601
      IF (D3.GE.0.0) CONTB(III)=CONTB(III-1)-CI                             1602
      GO TO 341                                                             1603
  343 POS3X(III)=SQX+((DC/ABS(D3))*SP)                                      1604
      POS3Y(III)=SQY+((DC/ABS(D3))*SP)                                      1605
      GO TO 346                                                             1606
  344 POS3X(III)=SQX+(DC/ABS(D3))*SP                                        1607
      POS3Y(III)=SQY-(DC/ABS(D3))*SP                                        1608
      GO TO 346                                                             1609
  345 POS3X(III)=SQX-((DC/ABS(D3))*SP)                                      1610
      POS3Y(III)=SQY-((DC/ABS(D3))*SP)                                      1611
      GO TO 346                                                             1612
  340 CONTB(III)=0.0                                                        1613
      RETURN                                                                1614
      END                                                                   1615
      SUBROUTINE LINE4 (DEPTHJ,DEPTHK,CI,INDEX,I4 ,D4)                      1616
      COMMON /BLK6/ SP                                                      1617
      COMMON /BLK8/ SQX,SQY                                                 1618
      COMMON /BLK12/POS4X(20),POS4Y(20),CONTC(20)                           1619
      D4=DEPTHJ-DEPTHK                                                      1620
      KX=DEPTHJ/CI                                                          1621
      SX=KX                                                                 1622
      IF (D4.LT.0) CONTC(I4 )=SX*CI+CI                                      1623
      IF (D4.GE.0) CONTC(I4 )=SX*CI                                         1624
  207 CONTINUE                                                              1625
      IF (D4) 1,2,2                                                         1626
    1 CONTINUE                                                              1627
      IF (CONTC(I4)-DEPTHK.LE.0.0.AND.D4.LT.0.0)208,209                     1628
    2 CONTINUE                                                              1629
      IF (CONTC(I4)-DEPTHK.LT.0.0.AND.D4.GE.0.0)209,208                     1630
  208 IF (D4.LT.0) DC=CONTC(I4 )-DEPTHJ                                     1631
      IF (D4.GE.0.0) DC=DEPTHJ-CONTC(I4)                                    1632
      IF (D4.EQ.0.0) D4=0.000000001                                         1633
      GO TO (210,211,212,213) ,INDEX                                        1634
  210 POS4X(I4)=SQX-SP+((DC/ABS(D4))*SP)                                    1635
      POS4Y(I4)=SQY+SP                                                      1636
  214 I4=I4+1                                                               1637
      IF(I4 .GT.20) PRINT 500                                               1638
C     IF(I4.GT.20) B=(FOUR/0.0)**2                                          1639
  500 FORMAT(* CONTOUR INTERVAL IS TOO SMALL*/)                             1640
      IF (D4.LT.0.0) CONTC(I4 )=CONTC(I4 -1)+CI                             1641
      IF (D4.GE.0.0) CONTC(I4 )=CONTC(I4 -1)-CI                             1642
      GO TO 207                                                             1643
  211 POS4X(I4)=SQX+SP                                                      1644
      POS4Y(I4)=SQY+SP-((DC/ABS(D4))*SP)                                    1645
      GO TO 214                                                             1646
  212  POS4X(I4)=SQX+SP-((DC/ABS(D4))*SP)                                   1647
      POS4Y(I4)=SQY-SP                                                      1648
      GO TO 214                                                             1649
  213 POS4X(I4)=SQX-SP                                                      1650
      POS4Y(I4)=SQY-SP+((DC/ABS(D4))*SP)                                    1651
      GO TO 214                                                             1652
  209 CONTC(I4)=0.0                                                         1653
      RETURN                                                                1654
      END                                                                   1655
      SUBROUTINE LINE5 (DEPTHL,DEPTHK,CI,INDEX,I5 ,D5)                      1656
      COMMON /BLK6/ SP                                                      1657
      COMMON /BLK8/ SQX,SQY                                                 1658
      COMMON /BLK13/POS5X(20),POS5Y(20),CONTD(20)                           1659
      D5=DEPTHL-DEPTHK                                                      1660
      KX=DEPTHL/CI                                                          1661
      SX=KX                                                                 1662
      IF (D5.LT.0) CONTD(I5 )=SX*CI+CI                                      1663
      IF (D5.GE.0) CONTD(I5 )=SX*CI                                         1664
  244 CONTINUE                                                              1665
      IF (D5) 1,2,2                                                         1666
    1 CONTINUE                                                              1667
      IF (CONTD(I5)-DEPTHK.LE.0.0.AND.D5.LT.0.0) 245,246                    1668
    2 CONTINUE                                                              1669
      IF (CONTD(I5)-DEPTHK.LT.0.0.AND.D5.GE.0.0) 246,245                    1670
  245 IF (D5.LT.0) DC=CONTD(I5 )-DEPTHL                                     1671
      IF (D5.GE.0.0) DC=DEPTHL-CONTD(I5)                                    1672
      IF (D5.EQ.0.0) D5=0.000000001                                         1673
      GO TO (247,248,249,250) ,INDEX                                        1674
  247 POS5X(I5)=SQX                                                         1675
      POS5Y(I5)=SQY+((DC/ABS(D5))*SP)                                       1676
  251 I5=I5+1                                                               1677
      IF(I5 .GT.20) PRINT 500                                               1678
C     IF(I5.GT.20) B=(FOUR/0.0)**2                                          1679
  500 FORMAT(* CONTOUR INTERVAL IS TOO SMALL*/)                             1680
      IF (D5.LT.0.0) CONTD(I5 )=CONTD(I5 -1)+CI                             1681
      IF (D5.GE.0.0) CONTD(I5 )=CONTD(I5 -1)-CI                             1682
      GO TO 244                                                             1683
  248 POS5X(I5)=SQX+((DC/ABS(D5))*SP)                                       1684
      POS5Y(I5)=SQY                                                         1685
      GO TO 251                                                             1686
  249 POS5X(I5)=SQX                                                         1687
      POS5Y(I5)=SQY-((DC/ABS(D5))*SP)                                       1688
      GO TO 251                                                             1689
  250 POS5X(I5)=SQX-((DC/ABS(D5))*SP)                                       1690
      POS5Y(I5)=SQY                                                         1691
      GO TO 251                                                             1692
  246 CONTD(I5)=0.0                                                         1693
      RETURN                                                                1694
      END                                                                   1695
      SUBROUTINE PLOT (POS3X,POS3Y,POS1X,POS1Y,POS2X,POS2Y,CONTA,ISIGN)     1696
      COMMON /BLK7/ N,NN,PX1,PY1,XMAX,YMAX,XMAY,YMAY,CI                     1697
      COMMON /LIMITS/ MINI,MAXI,IADDI                                       1698
      DATA OCT/37700000000000000000B/                                       1699
      CALL CALPLT (POS3X,POS3Y,3)                                           1700
      CALL CALPLT (POS1X,POS1Y,2)                                           1701
      DX=POS2Y-PY1                                                          1702
      DY=POS2X-PX1                                                          1703
      S=SQRT((DX*DX)+DY*DY)                                                 1704
      AMAX=XMAX+0.05                                                        1705
      TEMPX=CONTA                                                           1706
      IF (CONTA.LT.100) GO TO 29                                            1707
      CONTA=CONTA-IADDI                                                     1708
      IF (S-0.07) 29,30,30                                                  1709
   30 IF (POS2X-0.0015) 23,22,22                                            1710
   23 CALL COLUMN (-0.05,POS2Y,0.07,CONTA,0.0,-1)                           1711
      PY1=POS2Y                                                             1712
      PX1=POS2X                                                             1713
      GO T O 29                                                             1714
   22 IF (POS2Y+0.0015) 24,24,25                                            1715
   25 CALL NUMBER (POS2X,0.05,0.07,CONTA,90.0,-1)                           1716
      PY1=POS2Y                                                             1717
      PX1=POS2X                                                             1718
      GO TO 29                                                              1719
   24 IF (POS2Y+YMAX-0.0515) 26,27,27                                       1720
   26 CALL COLUMN (POS2X,YMAY,0.07,CONTA,90.0,-1)                           1721
      PY1=POS2Y                                                             1722
      PX1=POS2X                                                             1723
      GO TO 29                                                              1724
   27 IF (POS2X-XMAX+0.0015) 29,29,28                                       1725
   28 CALL NUMBER (AMAX,POS2Y,0.07,CONTA,0.0,-1)                            1726
   99 CONTINUE                                                              1727
      PY1=POS2Y                                                             1728
      PX1=POS2X                                                             1729
   29 N=N-1*ISIGN                                                           1730
      CONTA=TEMPX                                                           1731
      NN=NN+1                                                               1732
      RETURN                                                                1733
      END                                                                   1734
      SUBROUTINE COLUMN (X,Y,S,FPN,TH,N)                                    1735
C      X AND Y ARE THE COORDINATES OF THE LOWER RIGHTMOST EDGE              1736
C      S    IS THE SIZE OF CHARACTER TO BE USED IN PRINTING                 1737
C      FPN IS AN ACTUAL FLOATING POINT NUMBER WHOSE VALUE IS TO BE          1738
C          PRINTED ON THE PLOTTED  OUTPUT                                   1739
C      TH    IS AN ANGLE (DEGREES) AT WHICH THE NUMBER IS TO APPEAR         1740
C      N  IS AN INTEGER SPECIFYING THE ACCURACY TO WHICH THE NUMBER IS      1741
C         TO BE PRINTED                                                     1742
      SPC = .857143                                                         1743
      SPG =.285714                                                          1744
      NL = 0                                                                1745
      M = 0                                                                 1746
      IF (N) 50,20,20                                                       1747
   20 NL = N+1                                                              1748
      M = N                                                                 1749
   50 TFPN = ROUND(FPN)                                                     1750
       IFPN = TFPN*10**M                                                    1751
      IF (IFPN) 70,55,75                                                    1752
   55 IF (TFPN) 60,60,100                                                   1753
   60 NL = NL+1                                                             1754
      GO TO 100                                                             1755
   70 NL = NL+1                                                             1756
      TFPN = ABS(TFPN)                                                      1757
   75 M = 0.4343*ALOG(TFPN)+1.0                                             1758
      IF (M) 100,100,80                                                     1759
   80 NL = NL + M                                                           1760
  100 DLT =(SPC * S *(FLOAT(NL)))-(SPG*S)                                   1761
      T = TH*0.017453                                                       1762
      YP = Y -(DLT*SIN(T))                                                  1763
      XP = X -(DLT*COS(T))                                                  1764
  120 CALL NUMBER (XP,YP,S,FPN,TH,N)                                        1765
      RETURN                                                                1766
      END                                                                   1767
      SUBROUTINE DISCOT (XA,ZA,TABX,TABY,TABZ,NC,NY,NZ,ANS)              DISCOT
C     THE DIMENSIONS IN THIS SUBROUTINE ARE ONLY DUMMY DIMENSIONS.       DISCOT
      DIMENSION TABX(2),TABY(2),TABZ(2),NPX(8),NPY(8),YY(8)              DISCOT
C     DIMENSION TABX(2),TABY(2),TABZ(2),NPX(8),NPY(8),YY(8)              DISCOT
      CALL UNS (NC,IA,IDX,IDZ,IMS)                                       DISCOT
      IF (NZ-1)   5,5,10                                                 DISCOT
    5 CALL DISSER (XA,TABX(1),1,NY,IDX,NN)                               DISCOT
      NNN=IDX+1                                                          DISCOT
      CALL LAGRAN (XA,TABX(NN),TABY(NN),NNN,ANS)                         DISCOT
      GOTO 70                                                            DISCOT
   10 ZARG=ZA                                                            DISCOT
      IP1X=IDX+1                                                         DISCOT
      IP1Z=IDZ+1                                                         DISCOT
      IF (IA)   15,25,15                                                 DISCOT
   15 IF (ZARG-TABZ(NZ))   25,25,20                                      DISCOT
   20 ZARG=TABZ(NZ)                                                      DISCOT
   25 CALL DISSER (ZARG,TABZ(1),1,NZ,IDZ,NPZ)                            DISCOT
      NX=NY/NZ                                                           DISCOT
      NPZL=NPZ+IDZ                                                       DISCOT
      I=1                                                                DISCOT
      IF (IMS)   30,30,40                                                DISCOT
   30 CALL DISSER (XA,TABX(1),1,NX,IDX,NPX(1))                           DISCOT
      DO 35 JJ=NPZ,NPZL                                                  DISCOT
      NPY(I)=(JJ-1)*NX+NPX(1)                                            DISCOT
      NPX(I)=NPX(1)                                                      DISCOT
   35 I=I+1                                                              DISCOT
      GOTO 50                                                            DISCOT
   40 DO 45 JJ=NPZ,NPZL                                                  DISCOT
      IS=(JJ-1)*NX+1                                                     DISCOT
      CALL DISSER (XA,TABX(1),IS,NX,IDX,NPX(I))                          DISCOT
      NPY(I)=NPX(I)                                                      DISCOT
   45 I=I+1                                                              DISCOT
   50 DO 55 LL=1,IP1Z                                                    DISCOT
      NLOC=NPX(LL)                                                       DISCOT
      NLOCY=NPY(LL)                                                      DISCOT
   55 CALL LAGRAN(XA,TABX(NLOC),TABY(NLOCY),IP1X,YY(LL))                 DISCOT
      CALL LAGRAN (ZARG,TABZ(NPZ),YY(1),IP1Z,ANS)                        DISCOT
   70 RETURN                                                             DISCOT
      END                                                                DISCOT
C   1F1.1   0                                         MATINV             MATINV
      SUBROUTINE MATINV(A,N,B,M,DETERM,IPIVOT,INDEX,NMAX,ISCALE)         MATINV
                                                                         MATINV
********* DOCUMENT DATE 08-01-68   SUBROUTINE REVISED 08-01-68 ********* MATINV
C                                                                        MATINV
C     MATRIX INVERSION WITH ACCOMPANYING SOLUTION OF LINEAR EQUATIONS    MATINV
C                                                                        MATINV
      DIMENSION IPIVOT(N),A(NMAX,N),B(NMAX,M),INDEX(NMAX,2)              MATINV
      EQUIVALENCE (IROW,JROW), (ICOLUM,JCOLUM), (AMAX, T, SWAP)          MATINV
C                                                                        MATINV
C     INITIALIZATION                                                     MATINV
C                                                                        MATINV
    5 ISCALE=0                                                           MATINV
    6 R1=10.0**100                                                       MATINV
    7 R2=1.0/R1                                                          MATINV
   10 DETERM=1.0                                                         MATINV
   15 DO 20 J=1,N                                                        MATINV
   20 IPIVOT(J)=0                                                        MATINV
   30 DO 550 I=1,N                                                       MATINV
C                                                                        MATINV
C     SEARCH FOR PIVOT ELEMENT                                           MATINV
C                                                                        MATINV
   40 AMAX=0.0                                                           MATINV
   45 DO 105 J=1,N                                                       MATINV
   50 IF (IPIVOT(J)-1) 60, 105, 60                                       MATINV
   60 DO 100 K=1,N                                                       MATINV
   70 IF (IPIVOT(K)-1) 80, 100, 740                                      MATINV
   80 IF (ABS(AMAX)-ABS(A(J,K)))85,100,100                               MATINV
   85 IROW=J                                                             MATINV
   90 ICOLUM=K                                                           MATINV
   95 AMAX=A(J,K)                                                        MATINV
  100 CONTINUE                                                           MATINV
  105 CONTINUE                                                           MATINV
      IF (AMAX) 110,106,110                                              MATINV
  106 DETERM=0.0                                                         MATINV
      ISCALE=0                                                           MATINV
      GO TO 740                                                          MATINV
  110 IPIVOT(ICOLUM)=IPIVOT(ICOLUM)+1                                    MATINV
C                                                                        MATINV
C     INTERCHANGE ROWS TO PUT PIVOT ELEMENT ON DIAGONAL                  MATINV
C                                                                        MATINV
  130 IF (IROW-ICOLUM) 140, 260, 140                                     MATINV
  140 DETERM=-DETERM                                                     MATINV
  150 DO 200 L=1,N                                                       MATINV
  160 SWAP=A(IROW,L)                                                     MATINV
  170 A(IROW,L)=A(ICOLUM,L)                                              MATINV
  200 A(ICOLUM,L)=SWAP                                                   MATINV
  205 IF(M) 260, 260, 210                                                MATINV
  210 DO 250 L=1, M                                                      MATINV
  220 SWAP=B(IROW,L)                                                     MATINV
  230 B(IROW,L)=B(ICOLUM,L)                                              MATINV
  250 B(ICOLUM,L)=SWAP                                                   MATINV
  260 INDEX(I,1)=IROW                                                    MATINV
  270 INDEX(I,2)=ICOLUM                                                  MATINV
  310 PIVOT=A(ICOLUM,ICOLUM)                                             MATINV
      IF (PIVOT) 1000,106,1000                                           MATINV
C                                                                        MATINV
C     SCALE THE DETERMINANT                                              MATINV
C                                                                        MATINV
 1000 PIVOTI=PIVOT                                                       MATINV
 1005 IF(ABS(DETERM)-R1)1030,1010,1010                                   MATINV
 1010 DETERM=DETERM/R1                                                   MATINV
      ISCALE=ISCALE+1                                                    MATINV
      IF(ABS(DETERM)-R1)1060,1020,1020                                   MATINV
 1020 DETERM=DETERM/R1                                                   MATINV
      ISCALE=ISCALE+1                                                    MATINV
      GO TO 1060                                                         MATINV
 1030 IF(ABS(DETERM)-R2)1040,1040,1060                                   MATINV
 1040 DETERM=DETERM*R1                                                   MATINV
      ISCALE=ISCALE-1                                                    MATINV
      IF(ABS(DETERM)-R2)1050,1050,1060                                   MATINV
 1050 DETERM=DETERM*R1                                                   MATINV
      ISCALE=ISCALE-1                                                    MATINV
 1060 IF(ABS(PIVOTI)-R1)1090,1070,1070                                   MATINV
 1070 PIVOTI=PIVOTI/R1                                                   MATINV
      ISCALE=ISCALE+1                                                    MATINV
      IF(ABS(PIVOTI)-R1)320,1080,1080                                    MATINV
 1080 PIVOTI=PIVOTI/R1                                                   MATINV
      ISCALE=ISCALE+1                                                    MATINV
      GO TO 320                                                          MATINV
 1090 IF(ABS(PIVOTI)-R2)2000,2000,320                                    MATINV
 2000 PIVOTI=PIVOTI*R1                                                   MATINV
      ISCALE=ISCALE-1                                                    MATINV
      IF(ABS(PIVOTI)-R2)2010,2010,320                                    MATINV
 2010 PIVOTI=PIVOTI*R1                                                   MATINV
      ISCALE=ISCALE-1                                                    MATINV
  320 DETERM=DETERM*PIVOTI                                               MATINV
C                                                                        MATINV
C     DIVIDE PIVOT ROW BY PIVOT ELEMENT                                  MATINV
C                                                                        MATINV
  330 A(ICOLUM,ICOLUM)=1.0                                               MATINV
  340 DO 350 L=1,N                                                       MATINV
  350 A(ICOLUM,L)=A(ICOLUM,L)/PIVOT                                      MATINV
  355 IF(M) 380, 380, 360                                                MATINV
  360 DO 370 L=1,M                                                       MATINV
  370 B(ICOLUM,L)=B(ICOLUM,L)/PIVOT                                      MATINV
C                                                                        MATINV
C     REDUCE NON-PIVOT ROWS                                              MATINV
C                                                                        MATINV
  380 DO 550 L1=1,N                                                      MATINV
  390 IF(L1-ICOLUM) 400, 550, 400                                        MATINV
  400 T=A(L1,ICOLUM)                                                     MATINV
  420 A(L1,ICOLUM)=0.0                                                   MATINV
  430 DO 450 L=1,N                                                       MATINV
  450 A(L1,L)=A(L1,L)-A(ICOLUM,L)*T                                      MATINV
  455 IF(M) 550, 550, 460                                                MATINV
  460 DO 500 L=1,M                                                       MATINV
  500 B(L1,L)=B(L1,L)-B(ICOLUM,L)*T                                      MATINV
  550 CONTINUE                                                           MATINV
C                                                                        MATINV
C     INTERCHANGE COLUMNS                                                MATINV
C                                                                        MATINV
  600 DO 710 I=1,N                                                       MATINV
  610 L=N+1-I                                                            MATINV
  620 IF (INDEX(L,1)-INDEX(L,2)) 630, 710, 630                           MATINV
  630 JROW=INDEX(L,1)                                                    MATINV
  640 JCOLUM=INDEX(L,2)                                                  MATINV
  650 DO 705 K=1,N                                                       MATINV
  660 SWAP=A(K,JROW)                                                     MATINV
  670 A(K,JROW)=A(K,JCOLUM)                                              MATINV
  700 A(K,JCOLUM)=SWAP                                                   MATINV
  705 CONTINUE                                                           MATINV
  710 CONTINUE                                                           MATINV
  740 RETURN                                                             MATINV
      END                                                                MATINV
          IDENT RECIN                                                    RECIN
          ENTRY  RECIN                                                   RECIN
*        **********                                   REVISED   08/01/68 RECIN
*                                                                        RECIN
* BLOCKED INPUT ROUTINE                                                  RECIN
* M.DECH, CONTROL DATA AT NASA-LRC                                       RECIN
*                                                                        RECIN
*CALLING SEQUENCE IS                                                     RECIN
*    CALL RECIN(LUN,1,K,L1,,LN)   OR                                     RECIN
*    CALL RECIN(LUN,2,K,ARR,FIRST,LAST,INCREMENT)                        RECIN
*                                                                        RECIN
 PARAMS   BSS    57                                                      RECIN
 NANE     VFD    42/0HRECIN,18/63                                        RECIN
 RECIN    DATA   0                                                       RECIN
          SA1    B2                                                      RECIN
          SB2    -1                                                      RECIN
          SX2    X1+B2                                                   RECIN
          ZR     X2,TYPE1                                                RECIN
          SX2    X2+B2                                                   RECIN
          ZR     X2,TYPE2                                                RECIN
          SA0    MSGA             TYPE NOT 1 OR 2                        RECIN
          JP     ERROR                                                   RECIN
 TYPE1    SA1    RECIN                                                   RECIN
          AX1    30                                                      RECIN
          SA2    X1+B2            FETCH CALL                             RECIN
          MX4    54                                                      RECIN
          AX2    18                                                      RECIN
          BX6    -X4*X2                                                  RECIN
          SX6    X6-3             FETCH ITEMS IN LIST                    RECIN
          SA6    NUMBPAR          STORE IT                               RECIN
          RJ     GETFET           RETURNS WITH FET ADDRESS IN B2         RECIN
          RJ     READ                                                    RECIN
          SA1    FETADDR                                                 RECIN
          SA2    X1+3             GET OUT                                RECIN
          SA3    X2               X3=LENGTH THIS RECORD                  RECIN
          SX3    X3-1                                                    RECIN
          SA4    NUMBPAR                                                 RECIN
          IX6    X3-X4                                                   RECIN
          PL     X6,MOVEA                                                RECIN
          BX4    X3               SET SHORTER VALUE IN X4                RECIN
 MOVEA    SA5    A2+1             X5=LIMIT                               RECIN
*FIRST THE PARAMETERS WITH ADDRESSES IN THE B-REGISTERS                  RECIN
*MUST BE MOVED                                                           RECIN
          SX7    X2                                                      RECIN
          SX5    X5               MAKE SURE WE HAVE 18 BITS              RECIN
          RJ     ADVOUT           OUT TO X7                              RECIN
          SA3    X7                                                      RECIN
          BX6    X3                                                      RECIN
          SA6    B4               STORE 1ST                              RECIN
          SX4    X4-1                                                    RECIN
          ZR     X4,OUT           JUMP ON LIST END                       RECIN
          RJ     ADVOUT                                                  RECIN
          SA3    X7                                                      RECIN
          BX6    X3                                                      RECIN
          SA6    B5               STORE 2ND                              RECIN
          SX4    X4-1                                                    RECIN
          ZR     X4,OUT                                                  RECIN
          RJ     ADVOUT                                                  RECIN
          SA3    X7                                                      RECIN
          BX6    X3                                                      RECIN
          SA6    B6               STORE 3RD                              RECIN
          SX4    X4-1                                                    RECIN
          ZR     X4,OUT                                                  RECIN
*LIST LONGER THAN 3 WORDS SO LOOP TO END                                 RECIN
          SB1    1                                                       RECIN
          SB2    PARAMS                                                  RECIN
 LOOPA    RJ     ADVOUT                                                  RECIN
          SA3    X7                                                      RECIN
          SA2    B2                                                      RECIN
          BX6    X3                                                      RECIN
          SA6    X2                                                      RECIN
          SB2    B2+B1                                                   RECIN
          SX4    X4-1                                                    RECIN
          NZ     X4,LOOPA                                                RECIN
*MUST NOW REPOSITION OUT AND EXIT                                        RECIN
 OUT      SA1    FETADDR                                                 RECIN
          SA2    X1+3                                                    RECIN
          SX2    X2                                                      RECIN
          SA3    X2               X3=TOTAL LENGTH                        RECIN
          IX6    X3+X2            X6=OUT+LENGTH                          RECIN
          IX0    X6-X5                                                   RECIN
          NG     X0,SETOUT                                               RECIN
          SA2    X1+1             FETCH FIRST                            RECIN
          SX2    X2                                                      RECIN
          IX6    X0+X2            NEW OUT                                RECIN
 SETOUT   SA6    X1+3             STORE NEW OUT                          RECIN
          SX7    X3-1             WORD COUNT TO X7                       RECIN
          MX2    0                                                       RECIN
 SETK     SA7    B3                                                      RECIN
          PL       X2,RECIN       EXIT IF NOT EOF                        RECIN
          SA1      FETADDR                                               RECIN
          SA2      X1+14                                                 RECIN
          MX6    2                                                       RECIN
          SA6      A2                                                    RECIN
          JP     RECIN            EXIT                                   RECIN
 GETFET   DATA   0                                                       RECIN
          SB2    B0-B1                                                   RECIN
          RJ     =XGETBA                                                 RECIN
          GE     B2,B0,CHECK                                             RECIN
          SA0    MSGC             UNASSIGNED MEDIUM                      RECIN
          JP     ERROR                                                   RECIN
 CHECK    SA1    B2                                                      RECIN
          SX7    B2                                                      RECIN
          SA7    FETADDR          STORE IT                               RECIN
          LX1      57                                                    RECIN
          PL       X1,NOWRT                                              RECIN
          SA0      MSGE                                                  RECIN
          JP       ERROR                                                 RECIN
 NOWRT    LX1      3                                                     RECIN
          MX2    54                                                      RECIN
          BX3    -X2*X1           SEE IF UNUSED                          RECIN
          NZ     X3,GETFET        EXIT IF USED                           RECIN
          SB7      B6                                                    RECIN
          SX1      B2                                                    RECIN
          SX2    120B        OPEN ALTER                                  RECIN
          RJ       =XOPEN.                                               RECIN
          SB6      B7                                                    RECIN
          SA2    X1                                                      RECIN
          MX0    45                                                      RECIN
          BX2    X2*X0                                                   RECIN
          AX0    14                                                      RECIN
          IX6    X2-X0                                                   RECIN
          SA6    X1                                                      RECIN
          JP     GETFET                                                  RECIN
 READ     DATA   0                                                       RECIN
          SA1    FETADDR                                                 RECIN
          SA2    X1                                                      RECIN
          LX2    54                                                      RECIN
          NG     X2,FURTHER   NOT EOR OR EOF                             RECIN
          LX2    1                                                       RECIN
          PL     X2,FURTHER       NO EOR STATUS                          RECIN
          SA3    X1+2             FETCH IN                               RECIN
          SA4    X1+3             FETCH OUT                              RECIN
          SX4    X4                                                      RECIN
          IX0    X3-X4                                                   RECIN
          NZ     X0,FURTHER       JUMP IF STILL DATA                     RECIN
          SA4    X1                                                      RECIN
          MX3    42                                                      RECIN
          BX6    X3*X4                                                   RECIN
          SX3    13B                                                     RECIN
          BX6    X6+X3                                                   RECIN
          SA6    X1                                                      RECIN
          MX7    0                SET EOF STATUS                         RECIN
          JP     SETK                                                    RECIN
 FURTHER  SA1    FETADDR                                                 RECIN
          SA2    X1+2             GET IN                                 RECIN
          SX2    X2               CUT TO 18 BITS                         RECIN
          SA3    X1+3             GET OUT                                RECIN
          SX3    X3                                                      RECIN
          IX6    X3-X2            OUT-IN                                 RECIN
          PL     X6,QFIT          GO CHECK FIT                           RECIN
          SA4    X1+1             GET FIRST                              RECIN
          SA5    X1+4             GET LIMIT                              RECIN
          SX4    X4                                                      RECIN
          SX5    X5                                                      RECIN
          IX4    X5-X4            BUFFER SIZE                            RECIN
          IX6    X4+X6            ADJUST ROOM IN BUFFER                  RECIN
 QFIT     ZR     X6,CANCALL       GO CALL ON BUFFER EMPTY                RECIN
          SX6    X6-1000B                                                RECIN
          NG     X6,NOCALL                                               RECIN
          SA1    FETADDR                                                 RECIN
          SA2    X1                                                      RECIN
          LX2    55                                                      RECIN
          NG     X2,NOCALL        DONT CALL ON EOR                       RECIN
          LX2    4                                                       RECIN
          PL     X2,NOCALL                                               RECIN
 CANCALL  RJ     CIOCALL                                                 RECIN
*AT THIS POINT WE MUST SEE IF A FULL RECORD IS PRESENT                   RECIN
 NOCALL   SA1    FETADDR                                                 RECIN
          SA2    X1+2             SET IN                                 RECIN
          SA3    X1+3             OUT                                    RECIN
          SX3    X3                                                      RECIN
          IX6    X2-X3            IN-OUT                                 RECIN
          PL     X6,QGET                                                 RECIN
          SA4    X1+1             FIRST                                  RECIN
          SA5    X1+4             LIMIT                                  RECIN
          SX4    X4                                                      RECIN
          SX5    X5                                                      RECIN
          IX7    X5-X4                                                   RECIN
          IX6    X6+X7                                                   RECIN
 QGET     ZR     X6,RECALL                                               RECIN
          SA3    X3                                                      RECIN
          IX7    X6-X3            EXIT IF RECORD PRESENT                 RECIN
          PL     X7,READ                                                 RECIN
 RECALL   SX6    3RRCL                                                   RECIN
          LX6    42                                                      RECIN
 WAITA    SA2    1                                                       RECIN
          NZ     X2,WAITA                                                RECIN
          SA6    A2               STORE RCL                              RECIN
 WAITB    SA2    A6               AND WAIT TILL                          RECIN
          NZ     X2,WAITB         PICKED UP,THEN                         RECIN
         SA2       X1                                                    RECIN
         LX2       59                                                    RECIN
          NG        X2,READ+1      RESTART IF EOR                        RECIN
          JP     NOCALL           RECHECK                                RECIN
 CIOCALL  DATA   0                                                       RECIN
 WAITC    SA1    FETADDR                                                 RECIN
          SA2    X1                                                      RECIN
          LX2    59                                                      RECIN
          NG       X2,GO                                                 RECIN
          SX6      3RRCL                                                 RECIN
          LX6      42             IF                                     RECIN
+         SA1      1              BUSY                                   RECIN
          NZ       X1,*           RECALL                                 RECIN
          SA6      A1                                                    RECIN
+         SA1      A6                                                    RECIN
          NZ       X1,*                                                  RECIN
          JP     CIOCALL                                                 RECIN
GO        MX3      48                                                    RECIN
          LX2    1                                                       RECIN
          SX4    12B                                                     RECIN
          BX5    X2*X3                                                   RECIN
          IX6    X4+X5                                                   RECIN
          SA6    X1               STORE BINARY READ REQUEST              RECIN
          SX4    3RCIO                                                   RECIN
          LX4    42                                                      RECIN
          IX6    X4+X1            X6=REQUEST                             RECIN
 WAITD    SA2    1                                                       RECIN
          NZ     X2,WAITD         WAIT RA+1.BUSY                         RECIN
          SA6    A2               STORE REQUEST                          RECIN
          JP     CIOCALL          AND EXIT                               RECIN
*NEXT ROUTINE IS USED                                                    RECIN
*TO ADVANCE OUT                                                          RECIN
 ADVOUT   DATA   0                                                       RECIN
*X5=LIMIT                                                                RECIN
*X7=OUT                                                                  RECIN
*DESTROYS A1,X1                                                          RECIN
          SX7    X7+1                                                    RECIN
          IX1    X7-X5                                                   RECIN
          NZ     X1,ADVOUT        EXIT IF NOT REACHED                    RECIN
          SA1    FETADDR                                                 RECIN
          SA1    X1+1                                                    RECIN
          SX7    X1                                                      RECIN
          JP     ADVOUT                                                  RECIN
 TYPE2    RJ     GETFET                                                  RECIN
          RJ     READ                                                    RECIN
          SA2    B5                                                      RECIN
          SB7    X2-1                                                    RECIN
          SB7    B7+B4            B7=1ST STORE ADDRESS                   RECIN
          SA2    B6                                                      RECIN
          SB6    X2-1                                                    RECIN
          SB6    B6+B4            B6=LAST                                RECIN
          SA2    PARAMS                                                  RECIN
          SA3    X2                                                      RECIN
          SB4    X3               B4=INCREMENT                           RECIN
          SA1    FETADDR                                                 RECIN
          SA2    X1+3                                                    RECIN
          SX7    X2                                                      RECIN
          SA5    X1+4             X5=LIMIT                               RECIN
          SX5    X5                                                      RECIN
          SA3    X7                                                      RECIN
          SB2    X3-1             B2=NUMBER OF WORDS THIS RECORD         RECIN
          SB1    1                                                       RECIN
 TLOOP    RJ     ADVOUT                                                  RECIN
          SA3    X7               LOAD DATA                              RECIN
          BX6    X3                                                      RECIN
          SA6    B7               STORE IT                               RECIN
          SB7    B7+B4            NEXT ADDRESS                           RECIN
          LT     B6,B7,OUT        JUMP IF FINISHED                       RECIN
          SB2    B2-B1                                                   RECIN
          NE     B2,B0,TLOOP      STILL DATA                             RECIN
          JP     OUT                                                     RECIN
 ERROR    BX7    X3                                                      RECIN
          SA7    FNAME                                                   RECIN
          SX2    A0                                                      RECIN
          SX1    ERRNUM                                                  RECIN
+         RJ     =XSYSTEM                                                RECIN
-         LT     B0,NANE                                                 RECIN
+         RJ     =XABNORML                                               RECIN
-         LT     B0,NANE                                                 RECIN
 MSGA     DATA   10H BAD TYPE                                            RECIN
          DATA   0                                                       RECIN
 MSGB     DATA   20H LIST EXCEEDS DATA                                   RECIN
          DATA   0                                                       RECIN
MSGC      DATA   30H UNASSIGNED FILE MEDIUM FILE                         RECIN
 FNAME    BSS    1                                                       RECIN
MSGD      DIS      ,* UNCHECKED END FILE*                                RECIN
          DATA     0                                                     RECIN
MSGE      DIS      ,* READ/WRITE SEQUENCE ERROR*                         RECIN
          DATA     0                                                     RECIN
ERRNUM    EQU    92                                                      RECIN
 FETADDR  DATA   0                                                       RECIN
 NUMBPAR  DATA   0                                                       RECIN
          END                                                            RECIN
          IDENT  RECOUT                                                  RECOUT
          ENTRY  RECOUT                                                  RECOUT
*        **********                                   REVISED   08/01/68 RECOUT
*                                                                        RECOUT
*BLOCKED OUTPUT ROUTINE                                                  RECOUT
*M.DECH,CONTROL DATA AT NASA-LRC                                         RECOUT
*                                                                        RECOUT
*CALLING SEQUENCE IS                                                     RECOUT
*    CALL RECOUT(LUN,1,K,L1,..,LN) OR                                    RECOUT
*    CALL RECOUT(LUN,2,K,ARRAY,FIRST,LAST,INCREMENT)                     RECOUT
*                                                                        RECOUT
 PARAMS   BSS    57                                                      RECOUT
 NANE     VFD    42/0HRECOUT,18/63                                       RECOUT
 RECOUT   DATA   0                                                       RECOUT
          SA1    B2               GET TYPE                               RECOUT
          SB2    -1                                                      RECOUT
          SX2    X1+B2                                                   RECOUT
          ZR     X2,TYPE1                                                RECOUT
          SX2    X2+B2                                                   RECOUT
          ZR     X2,TYPE2                                                RECOUT
          SA0    MSGA                                                    RECOUT
          JP     ERROR                                                   RECOUT
 TYPE1    RJ     GETNPAR                                                 RECOUT
          RJ     GETFET                                                  RECOUT
          RJ     TESTY            WONT RETURN UNTIL THERE IS ROOM        RECOUT
* MUST NOW STORECOUNT AND HANDLE B REGISTERS                             RECOUT
          SA1    FETADDR                                                 RECOUT
          SA2    X1+2                                                    RECOUT
          BX7    X2               X7=IN                                  RECOUT
          SA5    X1+4             X5=LIMIT                               RECOUT
          SX5    X5                                                      RECOUT
          SA3    NUMBPAR                                                 RECOUT
          SX6    X3+1                                                    RECOUT
          SA6    X7               STORE COUNT                            RECOUT
          RJ     ADVIN            BUMP IN                                RECOUT
          SA4    B4               LOAD ELEMENT 1                         RECOUT
          BX6    X4                                                      RECOUT
          SA6    X7               STORE                                  RECOUT
          RJ     ADVIN                                                   RECOUT
          SX3    X3-1                                                    RECOUT
          ZR     X3,CLEANUP       EXIT ON LIST END                       RECOUT
          SA4    B5               SAME FOR SECOND                        RECOUT
          BX6    X4                                                      RECOUT
          SA6    X7                                                      RECOUT
          RJ     ADVIN                                                   RECOUT
          SX3    X3-1                                                    RECOUT
          ZR     X3,CLEANUP                                              RECOUT
          SA4    B6               AND THIRD                              RECOUT
          BX6    X4                                                      RECOUT
          SA6    X7                                                      RECOUT
          RJ     ADVIN                                                   RECOUT
          SX3    X3-1                                                    RECOUT
          ZR     X3,CLEANUP                                              RECOUT
*NOW TO REST OF LIST                                                     RECOUT
          SB1    1                                                       RECOUT
          SB2    PARAMS                                                  RECOUT
 LOOPE    SA2    B2               LOAD ADDRESS                           RECOUT
          SA4    X2               GET IT                                 RECOUT
          BX6    X4                                                      RECOUT
          SA6    X7               STORE IT                               RECOUT
          RJ     ADVIN                                                   RECOUT
          SB2    B2+B1            SET FOR NEXT                           RECOUT
          SX3    X3-1                                                    RECOUT
          NZ     X3,LOOPE                                                RECOUT
*MUST NOW POSITION IN, CALL WRITE AND EXIT                               RECOUT
 CLEANUP  SA1    FETADDR                                                 RECOUT
          SA2    NUMBPAR                                                 RECOUT
          SA3    X1+2             IN                                     RECOUT
          SX2    X2+1             RECORD LENGTH                          RECOUT
          SA4    X1+4             LIMIT                                  RECOUT
          SX4    X4                                                      RECOUT
          IX7    X3+X2            IN+ LENGTH                             RECOUT
          IX6    X7-X4                                                   RECOUT
          NG     X6,SETIN         LT LIMIT IS OK                         RECOUT
          SA4    BSIZE            ELSE SUBTRACT                          RECOUT
          IX7    X7-X4            BSIZE                                  RECOUT
 SETIN    SA7    A3               STORE NEW IN                           RECOUT
          SB7    16B              SET OP CODE                            RECOUT
          SA1    B3               GET EOF INDICATOR                      RECOUT
          ZR     X1,MDCALL        NO EOF                                 RECOUT
          SB7    B7+10B           SET LOGICAL EOF                        RECOUT
 MDCALL   RJ     WRITE                                                   RECOUT
          JP     RECOUT           AND EXIT                               RECOUT
 TYPE2    RJ     GETNPAR                                                 RECOUT
          SA1    NUMBPAR                                                 RECOUT
          SX2    X1-4                                                    RECOUT
          SA0    MSGE                                                    RECOUT
          NZ     X2,ERROR                                                RECOUT
          RJ     COUNT                                                   RECOUT
          RJ     GETFET                                                  RECOUT
          RJ     TESTY                                                   RECOUT
          SA2    B5                                                      RECOUT
          SB7    X2-1                                                    RECOUT
          SB7    B7+B4            FIRST PICKUP ADDRESS                   RECOUT
          SA2    B6                                                      RECOUT
          SB6    X2-1                                                    RECOUT
          SB6    B6+B4                                                   RECOUT
          SA2    PARAMS                                                  RECOUT
          SA3    X2                                                      RECOUT
          SB4    X3               B4=INC                                 RECOUT
          SA1    FETADDR                                                 RECOUT
          SA2    X1+2                                                    RECOUT
          BX7    X2               X7=IN                                  RECOUT
          SA5    X1+4             X5=LIMIT                               RECOUT
          SX5    X5                                                      RECOUT
          SA1    NUMBPAR                                                 RECOUT
          SX6    X1+1                                                    RECOUT
          SA6    X7                                                      RECOUT
          RJ     ADVIN            READY FOR TRANSFERS                    RECOUT
 QLOOP    SA3    B7                                                      RECOUT
          BX6    X3                                                      RECOUT
          SA6    X7                                                      RECOUT
          RJ     ADVIN                                                   RECOUT
          SB7    B7+B4                                                   RECOUT
          GE     B6,B7,QLOOP                                             RECOUT
          JP     CLEANUP                                                 RECOUT
 COUNT    DATA   0                                                       RECOUT
          SX7    0                                                       RECOUT
          SA2    B5                                                      RECOUT
          SB7    X2-1                                                    RECOUT
          SX5    B7+B4            F                                      RECOUT
          SA2    B6                                                      RECOUT
          SX6    X2-1             L                                      RECOUT
          SX6    X6+B4                                                   RECOUT
          SA2    PARAMS                                                  RECOUT
          SA3    X2             X3=INC                                   RECOUT
 LOOPF    SX7    X7+1                                                    RECOUT
          IX5    X5+X3                                                   RECOUT
          IX2    X6-X5                                                   RECOUT
          PL     X2,LOOPF                                                RECOUT
          SA7    NUMBPAR                                                 RECOUT
          JP     COUNT                                                   RECOUT
 WRITE    DATA   0                                                       RECOUT
          SA1    FETADDR                                                 RECOUT
          SA2    X1+2             IN                                     RECOUT
          SA3    X1+3             OUT                                    RECOUT
          IX0    X2-X3                                                   RECOUT
          PL     X0,QQCHECK                                              RECOUT
          SA2    BSIZE                                                   RECOUT
          IX0    X0+X2                                                   RECOUT
 QQCHECK  SX0    X0-512                                                  RECOUT
          PL     X0,BCALL                                                RECOUT
          SX7    B7                                                      RECOUT
          LX7    55                                                      RECOUT
          PL     X7,WRITE                                                RECOUT
 BCALL    SB2    59               WAIT BUFFER BUSY                       RECOUT
          SA1    FETADDR                                                 RECOUT
          SA1    X1                                                      RECOUT
          LX5    B2,X1                                                   RECOUT
          NG       X5,GO                                                 RECOUT
          SX6      3RRCL          IF                                     RECOUT
          LX6      42             BUSY                                   RECOUT
+         SA1      1              RECALL                                 RECOUT
          NZ       X1,*                                                  RECOUT
          SA6      A1                                                    RECOUT
+         SA1      A6                                                    RECOUT
          NZ       X1,*                                                  RECOUT
          JP       WRITE+1                                               RECOUT
GO        MX5    51                                                      RECOUT
          BX6    X5*X1                                                   RECOUT
          SX0    B7                                                      RECOUT
          IX6    X0+X6                                                   RECOUT
          SA6    A1                                                      RECOUT
          SX6    3RCIO                                                   RECOUT
          LX6    42                                                      RECOUT
          SX1    A1                                                      RECOUT
          IX6    X6+X1                                                   RECOUT
 WAITA    SA1    1                                                       RECOUT
          NZ     X1,WAITA                                                RECOUT
          SA6    A1                                                      RECOUT
          JP     WRITE                                                   RECOUT
 ERROR    BX7    X3                                                      RECOUT
          SA7    FNAME                                                   RECOUT
          SX2    A0                                                      RECOUT
          SX1    ERRNUM                                                  RECOUT
+         RJ     =XSYSTEM                                                RECOUT
-         LT     B0,NANE                                                 RECOUT
+         RJ     =XABNORML                                               RECOUT
-         LT     B0,NANE                                                 RECOUT
 MSGA     DATA   10H BAD TYPE                                            RECOUT
          DATA   0                                                       RECOUT
MSGC      DATA   30H UNASSIGNED FILE MEDIUM FILE                         RECOUT
 FNAME    BSS    1                                                       RECOUT
ERRNUM    EQU    92                                                      RECOUT
 MSGD     DATA   20H BUFFER TOO SMALL                                    RECOUT
          DATA   0                                                       RECOUT
 MSGE     DATA   20H BAD PARAM COUNT                                     RECOUT
          DATA   0                                                       RECOUT
 MSGF     DIS       ,* WRITE/READ SEQUENCE ERROR*                        RECOUT
          DATA      0                                                    RECOUT
 FETADDR  BSS    1                                                       RECOUT
 BSIZE    DATA   0                                                       RECOUT
 NUMBPAR  DATA   0                                                       RECOUT
 TESTY    DATA   0                                                       RECOUT
 LOOP     SA1    FETADDR          MUST SEE IF ENOUGH ROOM                RECOUT
          SA2    X1+2             IN                                     RECOUT
          SA3    X1+3             OUT                                    RECOUT
          IX0    X3-X2                                                   RECOUT
          SA4    NUMBPAR          FETCH COUNT                            RECOUT
          PL     X0,QFIT          DOESNT NEED ADJUSTMENT                 RECOUT
          SA5    BSIZE                                                   RECOUT
          IX0    X0+X5                                                   RECOUT
 QFIT     ZR     X0,TESTY         JUMP IF BUFFER EMPTY                   RECOUT
          SX0    X0-1             ALLOW FOR POINTER                      RECOUT
          IX6    X4-X0                                                   RECOUT
          NG     X6,TESTY         ENOUGH ROOM                            RECOUT
          RJ     TWRITE           GO MAKE ROOM                           RECOUT
          JP     LOOP                                                    RECOUT
 TWRITE   DATA   0                                                       RECOUT
 LOOPA    SA1    FETADDR                                                 RECOUT
          SA2    X1               LOAD STATUS                            RECOUT
          LX2    59                                                      RECOUT
          NG     X2,CALLIT                                               RECOUT
          SX6    3RRCL            RECALL CODE                            RECOUT
          LX6    42                                                      RECOUT
 LOOPB    SA1    1                CHECK RA+1                             RECOUT
          NZ     X1,LOOPB         WAIT BUSY                              RECOUT
          SA6    A1                                                      RECOUT
 LOOPC    SA1    A6                                                      RECOUT
          NZ     X1,LOOPC         WAIT CLEAR                             RECOUT
          JP     TWRITE           GO BACK WITHOUT CALLING                RECOUT
 CALLIT   SB7    16B                                                     RECOUT
          RJ     WRITE            CIO CALL                               RECOUT
          JP     LOOPA            AND LOOP                               RECOUT
*ADVIN KEEPS IN IN X7,NEEDS LIMIT IN X5 ,DESTROYS A1,X1                  RECOUT
 ADVIN    DATA   0                                                       RECOUT
          SX7    X7+1             BUMP                                   RECOUT
          IX1    X7-X5            EXIT IF                                RECOUT
          NZ     X1,ADVIN         LIMIT NOT REACHED                      RECOUT
          SA1    FETADDR          FETCH FIRST                            RECOUT
          SA1    X1+1             INTO                                   RECOUT
          BX7    X1               X7                                     RECOUT
          JP     ADVIN                                                   RECOUT
 GETNPAR  DATA   0                                                       RECOUT
          SA1    RECOUT                                                  RECOUT
          AX1    30                                                      RECOUT
          SA2    X1+B2            FETCH CALL                             RECOUT
          MX4    54                                                      RECOUT
          AX2    18                                                      RECOUT
          BX6    -X4*X2                                                  RECOUT
          SX6    X6-3             FOR TYPE1 THIS                         RECOUT
          SA6    NUMBPAR          IS THE NUMBER OF LIST ITEMS            RECOUT
          JP     GETNPAR                                                 RECOUT
 GETFET   DATA   0                                                       RECOUT
          SB2    B0-B1                                                   RECOUT
          RJ     =XGETBA                                                 RECOUT
          GE     B2,B0,CHECK      GOT FET                                RECOUT
          SA0    MSGC             UNASSIGNED MEDIUM                      RECOUT
          JP     ERROR                                                   RECOUT
 CHECK    SA1    B2                                                      RECOUT
          MX2    54                                                      RECOUT
          BX3    -X2*X1           SEE IF UNUSED                          RECOUT
          NZ     X3,MCHECK                                               RECOUT
          SB7      B6                                                    RECOUT
          SX2    106B                                                    RECOUT
          SX1      B2                                                    RECOUT
          RJ       =XOPEN.                                               RECOUT
          SB6      B7                                                    RECOUT
          SA1    B2                                                      RECOUT
          MX2    42                                                      RECOUT
          BX3    X2*X1                                                   RECOUT
          SX2    17B                                                     RECOUT
          IX7    X3+X2                                                   RECOUT
          SA7    B2                                                      RECOUT
 MCHECK   SX7    B2                                                      RECOUT
          SA7    FETADDR                                                 RECOUT
          SA1       B2             CHECK LAST STATUS                     RECOUT
          LX1       57             CHECK WRITE BIT                       RECOUT
          NG        X1,SEQOK       JUMP IF LAST OP WRITE                 RECOUT
          LX1       3              RESTORE                               RECOUT
          SX2    50B                                                     RECOUT
          BX1       X1*X2                                                RECOUT
          BX1       X1-X2                                                RECOUT
          ZR     X1,RWD           JUMP IF REWIND                         RECOUT
          SA1       B2                                                   RECOUT
          SX2       60B                                                  RECOUT
          BX1       X1*X2                                                RECOUT
          BX1       X1-X2                                                RECOUT
          ZR        X1,RWD          JUMP IF UNLOAD                       RECOUT
          SA0       MSGF                                                 RECOUT
          JP        ERROR                                                RECOUT
 RWD      SA1    B2                                                      RECOUT
          LX1    59                                                      RECOUT
         NG     X1,RWDGO         JUMP IF COMPLETE                        RECOUT
 +        SA1    1                                                       RECOUT
          NZ     X1,*                                                    RECOUT
          SX6    3RRCL                                                   RECOUT
          LX6    42                                                      RECOUT
          SA6    A1                                                      RECOUT
+         SA1    A1                                                      RECOUT
          NZ     X1,*                                                    RECOUT
          EQ     RWD              GO CHECK DONE                          RECOUT
 RWDGO    LX1    1                                                       RECOUT
          MX2    48                                                      RECOUT
          SX6    17B              SET BINARY WRITE                       RECOUT
          BX1    X2*X1            SET STATUS COMPLETE                    RECOUT
         IX6    X6+X1                                                    RECOUT
          SA6    B2                                                      RECOUT
SEQOK     SA1    B2                                                      RECOUT
          LX1    55                                                      RECOUT
          PL     X1,SEQOK1   JUMP IF LAST OP NOT = EOR                   RECOUT
SEQOK0    SA1    B2          IF SO                                       RECOUT
          LX1    59          WAIT NOT BUSY                               RECOUT
          NG     X1,SEQOK1                                               RECOUT
+         SA1    1                                                       RECOUT
          NZ     X1,*                                                    RECOUT
          SX6    3RRCL                                                   RECOUT
          LX6    42                                                      RECOUT
          SA6    A1                                                      RECOUT
+         SA1    A1                                                      RECOUT
          NZ     X1,*                                                    RECOUT
          EQ     SEQOK0                                                  RECOUT
SEQOK1    BSS    0                                                       RECOUT
          SA1    X7+1             FIRST                                  RECOUT
          SA2    X7+4             LIMIT                                  RECOUT
          MX3    42                                                      RECOUT
          BX1    -X3*X1                                                  RECOUT
          BX2    -X3*X2                                                  RECOUT
          IX7    X2-X1                                                   RECOUT
          SA7    BSIZE            STORE BUFFER SIZE                      RECOUT
          SX6    X7-2000B                                                RECOUT
          PL     X6,GETFET        EXIT IF OK                             RECOUT
          SA0    MSGD             INSUFFICIENT BUFFER                    RECOUT
          JP     ERROR                                                   RECOUT
          END                                                            RECOUT
      SUBROUTINE AXES (X,Y,THETA,DIST,ORIGIX,DX,TMAJ,TMIN,BCD,HGT,N)     AXES
C     X,Y     ARE THE COORDINATES OF THE ORIGIN OF THE AXIS IN FLOATING  AXES
C             POINT INCHES.                                              AXES
C     THETA   IS THE ANGLE OF ROTATION MEASURED COUNTER-CLOCKWISE FROM   AXES
C             THE X-AXIS IN FLOATING POINT DEGREES.                      AXES
C     DIST    IS THE LENGTH OF THE AXIS IN FLOATING POINT INCHES AND     AXES
C             SHOULD BE A MULTIPLE OF TMAJ.                              AXES
C     ORIGIX  IS THE VALUE OF THE VARIABLE AT THE FIRST POINT OF THE     AXES
C             AXIS IN FLOATING POINT.                                    AXES
C     DX      IS THE DIFFERENCE BETWEEN THE SECOND AND THE FIRST VALUE   AXES
C             OF THE VARIABLE ALONG THE AXIS IN FLOATING POINT.          AXES
C     TMAJ    IS THE DISTANCE IN FLOATING POINT INCHES FOR MAJOR TIC     AXES
C             MARKS.  A NEGATIVE TMAJ SUPPRESSES MAGNITUDE ADJUSTMENT    AXES
C             OF THE NUMBERS WRITTEN AT THE TIC MARKS.                   AXES
C     TMIN     IS THE DIVISIONS PER INCH IN FLOATING POINT FOR THE MINOR AXES
C              TIC MARKS.                                                AXES
C     BCD     IS THE CHARACTER LABEL FOR THE AXIS.                       AXES
C     HGT     IS THE HEIGHT OF THE FULL SIZE CHARACTERS IN THE BCD       AXES
C             TITLE IN FLOATING POINT INCHES.                            AXES
C     N       IS THE NUMBER OF CHARACTERS IN THE BCD TITLE.  A NEGATIVE  AXES
C             N PLACES THE ANNOTATION ON THE CLOCKWISE SIDE OF THE AXIS  AXES
C             AND VICE-VERSA.                                            AXES
C                                                                        AXES
      DATA TEN/10./                                                      AXES
      TEMPP=0.                                                           AXES
      IF (TMIN) 200,5,10                                                 AXES
5     TIC=0.                                                             AXES
      GO TO 15                                                           AXES
10    TIC=1./TMIN                                                        AXES
15    DV=DX                                                              AXES
      ORIGIN=ORIGIX                                                      AXES
      TH=THETA*0.0174533                                                 AXES
      CTH=COS(TH)                                                        AXES
      STH=SIN(TH)                                                        AXES
      ASTH=ABS(STH)                                                      AXES
      CTHN=N*CTH                                                         AXES
      STHN=N*STH                                                         AXES
      L=IABS(N)                                                          AXES
      AL=FLOAT(L)                                                        AXES
      ATMAJ = ABS(TMAJ)                                                  AXES
      CATMAJ=CTH*ATMAJ                                                   AXES
      SATMAJ=STH*ATMAJ                                                   AXES
      HGTNUM=.75*HGT                                                     AXES
      IF (TIC.LE.0.0.OR.TIC.GT.ATMAJ) TIC=ATMAJ                          AXES
      NOTE=ROUND((DIST/ATMAJ+1.0))                                       AXES
      KOUNT = NOTE-1                                                     AXES
      IF (ASTH.GT..01) GO TO 30                                          AXES
      XN=X                                                               AXES
      YN = Y+(-.5 + SIGN(.986,CTHN))*HGTNUM                              AXES
      YS = 0.                                                            AXES
      GO TO 35                                                           AXES
   30 XN = X+(.143-(SIGN(.343,STHN)))*HGTNUM                             AXES
      YN = Y                                                             AXES
      YS = -.5*HGTNUM                                                    AXES
35    ADY=ABS(DV)*ATMAJ                                                  AXES
      EX=0.0                                                             AXES
      IF (TMAJ.LT.0.0) GO TO 60                                          AXES
      IF (ADY) 40,60,40                                                  AXES
40    IF (ADY-999.990) 55,45,45                                          AXES
45    ADY=ADY*0.10                                                       AXES
      EX=EX+1.0                                                          AXES
      GO TO 40                                                           AXES
50    ADY=ADY*10.0                                                       AXES
      EX=EX-1.0                                                          AXES
55    IF (ADY-0.010) 50,60,60                                            AXES
60    ABSV=ORIGIN/TEN**EX                                                AXES
      ADY=SIGN(ADY,DV)                                                   AXES
      BBSV = ROUND(ABSV)                                                 AXES
      BDY = ROUND(ADY)                                                   AXES
      IYY=2                                                              AXES
      ACK = (FLOAT(INT(BDY)))*100.                                       AXES
      ADC = FLOAT(INT((BDY*100.)))                                       AXES
      IF (ADC.NE.ACK) GO TO 65                                           AXES
      ACK = (FLOAT(INT(BBSV)))*100.                                      AXES
      ADC = FLOAT(INT((BBSV*100.)))                                      AXES
      IF (ADC.NE.ACK) GO TO 70                                           AXES
      IYY=-1                                                             AXES
      GO TO 75                                                           AXES
   65 ACK = (FLOAT(INT((BDY*10.))))*10.                                  AXES
      IF (ADC.NE.ACK) GO TO 75                                           AXES
   70 ADC = FLOAT(INT((BBSV*100.)))                                      AXES
      ACK = (FLOAT(INT((BBSV*10.))))*10.                                 AXES
      IF (ADC.NE.ACK) GO TO 75                                           AXES
      IYY=1                                                              AXES
75    IF (IYY-1) 80,85,90                                                AXES
80    COUNT=0.0                                                          AXES
      GO TO 95                                                           AXES
85    COUNT=2.0                                                          AXES
      GO TO 95                                                           AXES
90    COUNT=3.0                                                          AXES
95    DO 135 I=1,NOTE                                                    AXES
      TCOUNT=COUNT                                                       AXES
      IXX=IYY                                                            AXES
      IF (ABSV) 105,100,105                                              AXES
100   IXX=-1                                                             AXES
      TCOUNT=1.0                                                         AXES
      GO TO 115                                                          AXES
105   IF (ABSV.LT.0.0) TCOUNT=TCOUNT+1.0                                 AXES
      TABSV=ROUND(ABSV)                                                  AXES
110   IABSV=TABSV                                                        AXES
      IF (IABSV.EQ.0) GO TO 115                                          AXES
      TCOUNT=TCOUNT+1.                                                   AXES
      TABSV=TABSV*0.10                                                   AXES
      GO TO 110                                                          AXES
115   YR=YN                                                              AXES
      IF (I.EQ.1) GO TO 117                                              AXES
      IF (I.LT.KOUNT) GO TO 118                                          AXES
  117 YN = YN + YS                                                       AXES
  118 CONTINUE                                                           AXES
      TEMP=TCOUNT*HGTNUM*.857                                            AXES
      IF (TEMP.GT.TEMPP) TEMPP=TEMP                                      AXES
      IF (ASTH.LT..01) GO TO 120                                         AXES
      IF (STHN.GT.0.0) GO TO 125                                         AXES
      XR=XN                                                              AXES
      GO TO 130                                                          AXES
120   XR=XN-.5*TEMP+.143*HGTNUM                                          AXES
      GO TO 130                                                          AXES
125   XR=XN-TEMP                                                         AXES
130   CALL NUMBER (XR,YR,HGTNUM,ABSV,0.0,IXX)                            AXES
      ABSV=ABSV+ADY                                                      AXES
      XN=XN+CATMAJ                                                       AXES
135   YN=YN+SATMAJ                                                       AXES
      TEMP=TEMPP                                                         AXES
      IF (EX.EQ.0.0) GO TO 145                                           AXES
      IF (CTH.LT.(-.5)) GO TO 140                                        AXES
      XN=XN-CATMAJ*.5                                                    AXES
      YN=YN-SATMAJ*.75                                                   AXES
140   CALL NOTATE (XN,YN,.8*HGTNUM,3H X ,0.0,3)                          AXES
      CALL NOTATE (999.,999.,HGTNUM,2H10,0.0,2)                          AXES
      CALL WHERE (XN,YN,DUM)                                             AXES
      YN=YN+.5*HGTNUM                                                    AXES
      CALL NUMBER (XN,YN,.6*HGTNUM,EX,0.0,-1)                            AXES
145   IF (ASTH.GT..01) GO TO 150                                         AXES
      DXC=DIST*0.50-(AL*0.50)*HGT*0.8570*CTH                             AXES
      DYC=(-.5+SIGN(1.5,CTHN))*HGT*1.5                                   AXES
      THETX=0.0                                                          AXES
      GO TO 165                                                          AXES
150   IF (N.GT.0) GO TO 155                                              AXES
      ADD=HGT*1.5                                                        AXES
      GO TO 160                                                          AXES
155   ADD=HGT*.5                                                         AXES
160   DYC=-SIGN(TEMP+.4*HGTNUM+ADD,STHN)                                 AXES
      DXC=DIST*0.50-(AL*0.50)*HGT*0.8570                                 AXES
      THETX=THETA                                                        AXES
165   XT=X+CTH*DXC+DYC*ASTH                                              AXES
      YT=Y+STH*DXC+DYC*ABS(CTH)                                          AXES
      CALL NOTATE (XT,YT,HGT,BCD,THETX,L)                                AXES
      NTIC=DIST/TIC+1.5                                                  AXES
      XN=X+CTH*DIST                                                      AXES
      YN=Y+STH*DIST                                                      AXES
      CALL CALPLT (XN,YN,3)                                              AXES
      IRATIO=ATMAJ/TIC+.5                                                AXES
      KOUNT=IRATIO-1                                                     AXES
      DO 195 I=1,NTIC                                                    AXES
      KOUNT=KOUNT+1                                                      AXES
      IF (KOUNT.NE.IRATIO) GO TO 185                                     AXES
      KOUNT=0                                                            AXES
      HNUX=.25                                                           AXES
170   IF (N) 175,200,180                                                 AXES
175   XS=XN-HNUX*STH                                                     AXES
      YS=YN+HNUX*CTH                                                     AXES
      GO TO 190                                                          AXES
180   XS=XN+HNUX*STH                                                     AXES
      YS=YN-HNUX*CTH                                                     AXES
      GO TO 190                                                          AXES
185   HNUX=.125                                                          AXES
      GO TO 170                                                          AXES
190   CALL CALPLT (XN,YN,2)                                              AXES
      CALL CALPLT (XS,YS,2)                                              AXES
      CALL CALPLT (XN,YN,2)                                              AXES
      XN=XN-TIC*CTH                                                      AXES
195   YN=YN-TIC*STH                                                      AXES
200   RETURN                                                             AXES
      END                                                                AXES
      SUBROUTINE GRID (X,Y,XS,YS,M,N)                                    GRID
C                                                                        GRID
C     WHERE - (X,Y) IS THE STARTING POSITION OF GRID                     GRID
C             XS    IS THE SPACE OF GRID IN X DIRECTION.                 GRID
C             YS    IS THE SPACE OF GRID IN Y DIRECTION                  GRID
C             M     IS THE NUMBER OF DIVISION IN X DIRECTION.            GRID
C             N     IS THE NUMBER OF DIVISIONS IN Y DIRECTION.           GRID
C                                                                        GRID
      Y0=Y                                                               GRID
      IM=N+1                                                             GRID
      XF=X+XS*FLOAT(M)                                                   GRID
      X0=X                                                               GRID
      CALL CALPLT (X,Y,3)                                                GRID
      DO 5 I=1,IM                                                        GRID
      CALL CALPLT (X0,Y0,2)                                              GRID
      CALL CALPLT (XF,Y0,2)                                              GRID
      Y0=Y0+YS                                                           GRID
      XT=XF                                                              GRID
      XF=X0                                                              GRID
5     X0=XT                                                              GRID
      X0=X                                                               GRID
      Y0=Y                                                               GRID
      XF=Y+YS*FLOAT(N)                                                   GRID
      IM=M+1                                                             GRID
      DO 10 I=1,IM                                                       GRID
      CALL CALPLT (X0,XF,2)                                              GRID
      CALL CALPLT (X0,Y0,2)                                              GRID
      X0=X0+XS                                                           GRID
      XT=XF                                                              GRID
      XF=Y0                                                              GRID
10    Y0=XT                                                              GRID
      RETURN                                                             GRID
      END                                                                GRID
      SUBROUTINE LEROY                                                   LEROY
      COMMON /LANGLEY/ IFLTR,KINCR,IPDN,RETURNR,PENX,PENY,IEPE,IVIEW,NME LEROY
     1,IST,JST,KST,OFFSET,FRAME,NPG,IBAG,LUN,JTPWRI                      LEROY
     Z,IBA,DX,DY                                                         LEROY
C     *                                                                  LEROY
      KINCR=9200                                                         LEROY
      IPDN=30                                                            LEROY
      IFLTR=1                                                            LEROY
      GO TO 5                                                            LEROY
C     *                                                                  LEROY
      ENTRY BALLPT                                                       LEROY
      IPDN=20                                                            LEROY
      KINCR = 72                                                         LEROY
      IFLTR=0                                                            LEROY
C     *                                                                  LEROY
5     RETURN                                                             LEROY
      END                                                                LEROY
      SUBROUTINE SORT 2 (ISM,IFN,KEY)
C     THIS VERSION OF THE SHORT CALL IS ESPECIALLY CODED, I.E. ISM(8),
C     TO BE USED WITH RECIN/RECOUT, OR PERHAPS A COMPASS PROGRAM.
C     IN GENERAL, THE EFFECT OF SETTING ISM(8) TO ZERO IS THAT THE
C     OUTPUT RECORDS WILL BE IN PRUS DEPENDING ON THE DEVICE, SO SOME
C     PROVISION MUST BE MADE BY THE USERS PROGRAM TO DELINEATE THE
C     LOGICAL GROUPS.  AND IF HE IS USING FORTRAN, THE ENTIRE OUTPUT
C     FILE WILL APPEAR AS ONE RECORD.
      DIMENSION IFN(1)
      DIMENSION ISM(1)
      INTEGER SM(9),REC(8),VAR(6),CON(2)
      SM(1)=0
      ITYP=1HS
      GO TO 10
      ENTRY MERGE 2
      SM(1)=1
      ITYP=1HM
   10 CONTINUE
      SM(2)=ISM(1)
      SM(3)=ISM(2)
      SM(4)=ISM(3)
      SM(5)=1HZ
      SM(6) = 3
      SM(7)=1H
      SM(8)=0
      SM(9)=1HZ
      CALL SRTMRG(SM,IFN,KEY)
      REC(1)=ISM(4)
      REC(2)=1H
      REC(3)=1H
      REC(4)=1H
      REC(5)=SM(4)
      REC(6)=1HX
      REC(7)=1HO
      REC(8)=ISM(5)
      VAR(1)=0
      VAR(2)=1H
      VAR(3)=0
      VAR(4)=0
      VAR(5)=0
      VAR(6)=1H
      CON(1)=0
      CON(2)=1HN
      CALL SMFILS(IFN(1),REC,VAR,CON)
      REC(7)=ITYP
      NUM=ISM(1)
      DO 30 J=1,NUM
      CALL SMFILS(IFN(J+1),REC,VAR,CON)
   30 CONTINUE
      RETURN
      END
          IDENT     Q8QGFET
          ENTRY     Q8QGFET
          EXT       SYSTEM,ABNORML,GETBA
          VFD       42/0HGETFET,18/2
Q8QGFET   DATA      0
          SX6      B2
          SA6       BE2
*    B2 - ADDRESS OF WHERE TO PUT FET
          SB2       -B1
          RJ        GETBA
          LT        B2,B0,ERROR
          SB1      13        MOVE 13 WORDS FROM FORTRAN FET
          SA1       B2       TO INTERFACE FET
        BX6         X1
          SA3       BE2
          SA6       X3
          SB3       1
          SB2       B3
LOOP      SA1       A1+B2     NEXT WORD FROM FORTRAN FET
          BX6       X1
          SA6       A6+B2     NEXT WORD TO NEW FET
          SB3       B3+1        INCREMENT COUNTER
          GT        B1,B3,LOOP   FET+12 IS LAST
          SA1    A6-11       FET WORD -FIRST-
          MX0    59
          LX1    16
          BX7    X0*X1
          IX7    X7-X0
          LX7    44
          SA7    A1          TURN ON EP BIT
          EQ        Q8QGFET     RETURN
ERROR     SX2       MSG
          SX1       ERRNUM
          BX7       X3
          SA7       FNSAV
+         RJ        SYSTEM
-         LT     B0,B1,Q8QGFET-1
+         RJ        ABNORML
-         LT     B0,B1,Q8QGFET-1
MSG       DIS       3,SORT/MERGE CANT FIND FILE
FNSAV     BSS       1
ERRNUM    EQU       67
BE2       DATA      0
          END
          IDENT SRTMRG
          USE    0
          USE    //
 MURF     BSS    01
          USE    *
          ENTRY     SMFILS
          EXT       ABNORML,SYSTEM
          EXT       Q8QGFET
          ENTRY SRTMRG
          EXT       FBLA,FDBA,VBKA,VDKA,VBTA,VDTA,VBRA,VDRA,VBSA
          EXT    SMCON,VDRU,VBRU,PARS
          EXT    VDSA
GRONK     DATA      0
          RJ        SMCON
TAB1      BSS    450         FE
TAB2      EQU       TAB1+11
WORKST    BSS    800
 FETSQQ   BSS    704
 FETO     BSSZ   9
RJMP      EQ        GRONK
KEYS      DATA      10H KEYS
BLNK      DATA      10H
BLANK     EQU       BLNK
OUTPT     VFD    36/0HOUTPUT,24/0
MODE      DATA      0
WORKE     DATA   0
WORKL     EQU    100         2*LENG OF W.S.A.
WORK0     VFD    30/WORKST-WORKL/2,30/WORKST
READY     DATA      0
BE1       DATA      0
BE2       DATA      0
BE3       DATA      0
BE4       DATA      0
BE5       DATA      0         TEMPORARY STORAGE FOR B5
BE6       DATA      0         TEMPORARY STORAGE FOR B6
A         DATA      10HA
B         DATA      10HB
C         DATA      10HC
D         DATA      10HD
F         DATA      10HF
L         DATA      10HL
M         DATA      10HM
N         DATA      10HN
O         DATA      10HO
R         DATA      10HR
S         DATA      10HS
T         DATA      10HT
U         DATA      10HU
V         DATA      10HV
X         DATA      10HX
DISP      MACRO     LET,NEX,INS,CNT,ENDIST
          SA4       LET       GET LETTER
          BX5       X4-X3     WAS IT THAT ONE
          NZ        X5,NEX    NO,TRY ANOTHER
          SX0    INS
        IX6         X6+X0     YES INSERT VALUE
          LX6       CNT       GET SET FOR NEXT ONE
          EQ        ENDIST
          ENDM
BLOC      MACRO     BB,DB,DD,DF    BB-BLOCKER,DB-DEBLOCKER
          SA2       DD               DD-CHARACTER,DF-NEXT TEST
          BX4       X3-X2
          NZ        X4,DF
          SA1       BB
          SX6       A1
          LX6       30
          SA1       DB
          SX5       A1
          BX6       X5+X6
          SA6       FETO
          EQ        OOP
          ENDM
          VFD      42/0HSRTMRG,18/7
SRTMRG    DATA      0
          SA1    WORK0       INITIALIZE WORKE
          BX6    X1
          SA6    WORKE
          SX6       B5        TEMPORAY STORE B5
          SA6       BE5
          SX7       B6        TEMPORARY STORE B6
          SA7       BE6
          SX6       B4        TEMPORARY STORE B4
          SA6       BE4
          SX7       B3        TEMPORARY STORE B3
          SA7       BE3
          SX6       B2        TEMPORARY STORE B2
          SA6       BE2
          SA1       B1        GET SORT OR MERGE FLAG
          BX6       X1
          SA6       TAB1      STORE AS FIRST ENTRY
          ZR        X1,SRT1   FLAG 0,PROCESS NEXT PARAMETER
          AX1       1         MUST HAVE BEEN A ONE, SHIFT IT OFF
          ZR        X1,SRT1   GOOD GRIEF NOT 0,NOT 1
          SB1       1         MUST BE TYPE1 ERROR
+         RJ        ERROR
-         LT     B0,B1,SRTMRG-1
SRT1      SA1       A1+1      GET NO. FILES
          BX6       X1
          SA6       A6+1      STORE INTO TAB1+1
          SX7       X6+1
          SA7       READY     STORE INTO FILE COUNTER
          NG        X1,SRT2   IS IT NEGATIVE
          SX1       X1-33     THIS WILL MAKE IT NEGATOIVE
          NG        X1,SRT3
SRT2      SB1       2         OH NO,AN ERROR
ERR       RJ        ERROR
-         LT     B0,B1,SRTMRG-1
SRT3      SA1       A1+1      GET NO. KEY FIELDS
          BX6       X1
          SA6       A6+1      STORE  INTO TAB1+2
          SX1       X1-1
          NG        X1,SRT4   NO.KEYS LT 1
          SX1       X1-100
          NG        X1,SRT5
SRT4      SB1       3         NO.KEYS GT 100
ERRS      RJ        ERROR
-         LT     B0,B1,SRTMRG-1
SRT5      SA1       A1+1      GET RECORD LENGTH
          BX6       X1
          SA6       A6+1      STORE REC LENG IN TAB+3
          SX1       X1-1
          SB1       4
          NG        X1,ERRS
          SA1       A1+1      SEQ CHK.OPTION
          BX6       X1
          SA6       A6+1
          SA1       A1+1      PARITY ERROR OPTION
          SA3    BLNK
          BX6    X1-X3
          ZR     X6,SRT6     IT IS BLANK,DEFAULT TO ZERO.
          SB1    5
          NG     X1,ERR      IT IS NEGATIVE,ISSUE ERROR MSG.
          BX6    X1
          SX1    X1-6
          PL     X1,ERR      IT IS GT 5,ISSUE ERROR MSG.
 SRT6     SA6    A6+1
          SA1    A1+1        INPUT ORDER OPT.
          BX6       X1
          SA6       A6+1
          SA1       A1+1      CHARS PER PHYS REC
          BX6       X1
          SA6       A6+1
          SA1       A1+1      BLANK COMMON OPT
          BX6       X1
          SA6       A6+1
*     NEXT  COME THE FILES
          SA1       BE2
          SA0       X1        ADDRESS IN A0 OF INPUT FILE TABLE
          SA2       TAB1+1    GET NUMBER OF FILES
          SB5       X2
          SB4    FETSQQ      INITIALIZW TO START OF FETS
          SA1       A0
          NZ        X1,FN3    IS OUTPUT FILE NOT SPECIFIED
          SX6       B0
          SA6       TAB1+10   THEN STORE AWAY A ZERO
          EQ        FN1       NOW GO TO WORK ON INPUT FILES
FN3       SB1       A0        ADDRESS OF OUTPUT FILE NAME IN B
          SB2       B4        NEW FET ADDRESS IN B2
          SX6       B4        STORE AWAY NEW FET ADDRESS IN TA
          SA6       TAB1+10      FOR OUTPUT FILE
+         RJ        Q8QGFET
-         LT     B0,B1,SRTMRG-1
FN1       SB6       B0        INIT COUNTER
          SA0       A0+1      NEXT WORD IN INPUT FILE ARRAY
FN2       EQ        B6,B5,FN4 EXHAUSTED NUMBER INPUT FILES YET
*                             GET NEXT WORKD OF INPUT ARRAY
          SB1       A0+B6
          SB4    B4+22
          SX6       B4        PUT ADDRESS INTO TABLE
          SA6       TAB2+B6
          SB2       B4
          SB6       B6+1
+         RJ        Q8QGFET
-         LT     B0,B1,SRTMRG-1
          EQ        FN2       LOOP BACK
 FN4      SB4       B5+TAB2   TAB2 + NO. FILE=POS IN TABLE
*    NEXT COME THE KEYS
          SA1       BE3
          SB3       X1        ADDRESS OF KEYS TO B3
          SA4       TAB1+2    X4 HAS NO. OF KEY FIELDS
KLOP      SA1    KEYS
          BX6    X1
          SA6    B4
          SB4    B4+1
          SA1    B3
          SA2       A
          BX2       X1-X2     WAS IT AN A
          ZR        X2,K1
          SA2       D         NO
          BX2       X1-X2     WAS IT A D
          ZR        X2,K1
          SB1       6         NO
K2        RJ        ERROR
-         LT     B0,B1,SRTMRG-1
K1        MX5       6
          BX6       X5*X1
          SA6       B4        STORE SORT ORDER AWAY
          SB4       B4+1      INCREMENT TABLE POINTER
          SB3       B3+1      INCREMENT INPUT ARRAY ADDRESS
          SA1       B3
          SA2       C
          BX2       X2-X1     EQUAL C
          SB5       1         SET C FLAG
          ZR        X2,K3
          SA2       N         NO,EQUAL TO N
          BX2       X2-X1     N FLAG SAME AS C
          ZR        X2,K3
          SA2       F         NO,EQUAL TO F
          BX2       X2-X1
          SB5       0         SET F FLAG
          ZR        X2,K3
          SA2       X         NO,EQUAL TO X
          BX2       X1-X2     X FLAG SAME AS F
          ZR        X2,K3
          SA2       L         NO,EQUAL TO L
          BX2       X1-X2
          SB5       2         SET  L FLAG
          ZR        X2,K3
          SB1       7         ERROR
          EQ        K2
K3        BX6       X1*X5
          SA6       B4        STORE KEY TYPE
          SB4       B4+1      INCREMENT TABLE POINTER
          SB3       B3+1      INCREMENT INPUT ARRAY POINTER
          SA1       B3        GET KEY POSITION
          SB1       8         SET ERROR FLAG IN CASE
          SX1       X1-1      POSITION IS NOT POSITIVE
          NG        X1,K2
          SX6       X1+1      POS O.K.
          SA6       B4        PUT AWAY IN TABLE
          SB4       B4+1      INCREMENT TABLE POINTER
          SB3       B3+1      INCREMENT INPUT ADDRESS
          EQ        B5,B0,K4  SEE IF X OR F TYPE
          SA1       B3        NO
          SX1       X1-1      CHECK FOR POS. KEY LENGTH
          SB1       9         SET ERROR FLAG IN CASE
          NG        X1,K2
          SX6       X1+1
          SA6       B4
          EQ        K5
K4        SX6       1         X OR F TYPE SO
          SA6       B4        STORE A ONE
K5        SB4       B4+1      INCREMENT TABLE POINTER
          SB3       B3+1      INCREMENT INPUT ARRAY POINTER
          SX4       X4-1
          ZR        X4,K6
          EQ        KLOP
K6        SA1       RJMP
          BX6       X1
          SA6       B4
*    GET COLLATING SEQUENCE ADDRESS
          SA1       SRTMRG
          LX1       30
          SA2       X1-1
          AX2       18
          MX3       54
          BX4       -X3*X2
          SB2       4
          SB3       X4
          SX6    B0
          LT     B3,B2,CLNINE
          SA1       BE4
          BX6       X1
CLNINE    SA6    TAB1+9
*   EMPTY THE USERS OUTPUT BUFFER
          SB1    OUTPT
          SB2    -B1
          RJ     =XGETBA
          LT     B2,B0,NOFIL HE DOESNT HAVE ONE
          SA1    WRITE
          LX1    30
          MX3    42
          BX2    X3*X1
          SA5    B2
          BX5    -X3*X5
          ZR     X5,NOFIL         FILE HASNT EVER BEEN OPENED
          SX1    B2
          IX6    X2+X1
          LX6    30
          SA6    WRITE
          JP     WRITE
WRITE     WRITER OUTPT,0,RECALL
NOFIL     EQ     SRTMRG
*  THIS ENTRY POINT FOR FILLING WORDS 14-20 OF FETS
          VFD    42/0HSMFILS,18/1
SMFILS    DATA      0
          SX7       B2
          SX6       B1
          SA6       BE1      SAVE B1
          SA7       BE2      SAVE B2
          SX6       B3
          SX7       B4
          SA6       BE3      SAVE B3
          SA7       BE4      SAVE B4
          SX6       B5
          SA6       BE5      SAVE B5
          SA3       B2       CHECK RECORD TYPE - REC(1)
XF        BLOC      FBLA,FDBA,F,XV
XV        BLOC      VBKA,VDKA,V,XT STORE BLOCKER AND
XT        BLOC      VBTA,VDTA,T,XR
XR        BLOC      VBRA,VDRA,R,XS  DEBLOCKER ADDRESSES
 XS       BLOC   VBSA,VDSA,S,XU
 XU       BLOC   VBRU,VDRU,U,XX    IN WORD 14
XX        SB1       12
ERX       RJ        ERROR
-         LT     B0,B1,SMFILS-1
 OOP      SB5    B2
          SA3       B5+5     DISPOSAL CODE - REC(6)
          MX6    0
          DISP      R,DL,4,27,ENDIS
DL        DISP      L,DN,2,27,ENDIS
 DN       DISP   N,DO,1,27,ENDIS
 DO       DISP   O,DX,5,27,ENDIS
 DX       DISP   X,DE,3,27,ENDIS
DE        SB1       11
          EQ        ERX
ENDIS     SA3       B5+4     RECORD LENGTH - REC(5)
          IX6    X3+X6
          LX6       14
          SA3       B5+1     OPTIONAL/MANDATORY - REC(2)
          SA4       BLANK
          BX5       X3-X4
          ZR        X5,LS
          SX0    1
          IX6    X6+X0
LS        LX6       2
          SA3       B5+2     RESTART DUMP CONTROLLED
          BX5       X3-X4
          ZR        X5,SP4   BY RECORD COUNT - REC(3)
          SX0     2
          IX6    X6+X0
          LX6       8
SP4       SA3       B5+3     RESTART DUMP CONTROLLED
          BX5       X3-X4
          ZR        X5,LP8   BY END OF REEL - REC(4)
          SX0    1
          IX6    X6+X0
LP8       LX6       8
          SA3       B5+6     FILE USAGE - REC(7)
          DISP      S,U1,1,6,LOM
U1        DISP      M,U2,2,6,LOM
U2        DISP      O,U3,4,6,LOM
U3        SB1       12
          EQ        ERX
LOM       SA3       B5       RECORD TYPE - REC(1)
          DISP      F,RT2,1,0,RTE
RT2       DISP      V,RT3,2,0,RTE
RT3       DISP      R,RT4,4,0,RTE
RT4       DISP      T,RT5,8,0,RTE
 RT5      DISP   S,RT6,32,0,RTE
 RT6      DISP   U,RTE,16,0,RTE
RTE       SA6       FETO+1    WORD 15
          SX6    B0
          SA3    B5+7        PARITY MODE - REC(8)
          DISP   B,MD2,3,0,MD5
 MD2      DISP   C,MD2A,1,0,MD5
 MD2A     DISP   D,MD4,1,0,MD5
MD4       SB1    16
          EQ     ERX
MD5       SA6    MODE        SAVE MODE FOR STATUS INITIALIZATION
          SX6       0
          SA1       BE3
          SB2       X1
          SA1       X1+5     RECORD MARK VALUE - VAR(6)
          SA2       BLANK
          IX3       X2-X1
          ZR     X3,BLK      NONE SPECIFIED
          BX6       X1
BLK       LX6       24
          SA1     B5+4       LENGTH OF RECORD FROM REC(5)
          IX6       X1+X6
          LX6       30
          SA1       B2+4     LENGTH OF TRAILER ITEMS - VAR(5)
          IX6       X1+X6
          SA6       FETO+2   WORD 16
          SA1       B2+1     MODE OF COUNT FIELD - VAR(2)
          SA3       BLANK
          IX6       X3-X1
          ZR        X6,BLP
          SA3       B
          IX6       X3-X1
          ZR        X6,BLP   BINARY
          SA3       D
          IX6       X3-X1
          NZ        X6,GOON
          SX0    1           BCD
          IX6    X6+X0
          EQ        BLP
GOON      SA3       F
          IX6       X3-X1
          NZ        X6,ERK
          SX0     2          FLOATING POINT
          IX6    X6+X0
BLP       LX6       28
          SA1       B2+2     CHARACTER COUNT POSITION - VAR(3)
          IX6       X1+X6
          LX6       30
          SA1       B2+3     COUNT FIELD LENGTH - VAR(4)
          IX6       X6+X1
          SA6       FETO+3   WORD 17
          EQ        CONTR
 ERK      SB1       14
          EQ        ERX
CONTR     SA1       BE4
          SB2       X1
          SA1       X1+1     LABEL TYPE - CONTROL(2)
          SA3       S
          IX6       X3-X1
          ZR        X6,LAB   S
          SA3       N
          IX6      X3-X1
          NZ        X6,TRYU
          SX0     2          N
          IX6    X6+X0
          EQ        LAB
TRYU      SA3       U
          IX6       X3-X1
          NZ        X6,FIAL
          SX0    1           U
          IX6    X6+X0
          EQ        LAB
FIAL      SB1       15
          EQ       ERX
 ERRLL    SB1    17
          EQ     ERX
 LAB      LX6    35                LABEL ADDRESS-LA
          SA1       SMFILS   CHECK NUMBER OF CALLING PARAMETERS
          LX1       30
          SA2       X1-1
          AX2       18
          MX3       54
          BX4       -X3*X2
          SB2       5
          SB3       X4
          LT        B3,B2,NLAB     LESS THAN 5, NO LABEL PROCESSING
          SA4    BE5               X4=LABEL ADDRESS-1
          SA3    X4                X3=LABEL LENGTH
          NG     X3,ERRLL
          ZR     X3,ERRLL
          SX7    X3-121
          PL     X7,ERRLL
          IX6    X6+X3
          LX6    23
          SX4    X4+1
          BX6    X6+X4
NLAB      SA6       FETO+4   WORD 18
          SX6    B0
          SA6       FETO+5   WORD 19
          SA1    BE4
          SA6    FETO+7      WORD 21
          SA6    A6+1        WORD 22
          SA2    X1          RESTART DUMP PERIOD - CONTROL(1)
          SA1    FETO+1      CHECK WORD 15 FOR RECORD TYPE
          LX1    59
          PL     X1,GOAHED   NOT FIXED (LEAVE X6 = 0)
          LX1    1
          MX0    18
          LX0    48
          BX6    X0*X1       FIXED (SET X6 = RECORD LENGTH)
 GOAHED   IX6    X6+X2
          SA6       FETO+6   WORD 20
          SA1       BE1
          SA4       X1        FILE NAME
          SB5    FETSQQ      START OF FETS
          SA1       TAB1+1   NUMBER OF INPUT FILES
          SB4    4           *MULTYPLY
          LX2    B4,X1       *
          SB4    2           *     BY
          LX3    B4,X1       *
          IX3    X2+X3       *      TWENTY
          SB4    1           *
          LX2    B4,X1       *      TWO
          IX3    X2+X3       *
          SB4       X3
          SB6       B5+B4     ADDRESS OF LAST FET BA.
          RJ        FINDFET
          SA1       READY     HOW MANY FILES
          SX6       X1-1
          SA6       READY
          NZ        X6,SMFILS
          RJ        GRONK
+         EQ        SMFILS
*  THIS SECTION FOR TRACKING DOWN FILE NAME AND INSERTING
*      WORDS 14-20 AND NSERTING WORK AREA
*         ENTER WITH FILE NAME IN X4
*         WORDS 14-20 STARTING AT FETO
*         START OF FETS IN B5, LAST FET IN B6
FINDFET   DATA      0
          SB6       B6+1
          MX3       42
          SB2       B5
LOOPFET   SA1       B2
          BX1       X1*X3
          IX1       X1-X4
          ZR        X1,FOUND
          SB2    B2+22
          GE        B2,B6,OHNO
          EQ        LOOPFET
FOUND     SA1       WORKE     FILL IN WORK
          LX1    30
          SX6    WORKL
          IX6    X1+X6
          SA6       B2+5                    *
          SA6       WORKE
          SA1     B2
          MX7    42
          BX6    X7*X1
          SA1     MODE
          IX6     X6+X1
          SA6     B2         INITIALIZE CODE AND STATUS
          SB1       FETO
          SB3    22
          SB4       13
STUFF     SA1       B1
          BX6       X1
          SA6       B2+B4
          SB1       B1+1
          SB4       B4+1
          LT        B4,B3,STUFF
          EQ        FINDFET
OHNO      SB1       13
          EQ        ERX
          VFD    42/0HPRAMCHK,18/1
ERROR     DATA   0
          SX1    B1           GET ERROR NUMBER
          SX2    X1-1
          BX3    X2
          LX3    2           MULTUPLY BY 4 THEN
          IX2    X3+X2        ADD TO GET FICE
          SX3    MSG1         START ADDRESS OF MESSAGES
          IX2    X3+X2
+         RJ     SYSTEM
-         LT     B0,ERROR-1
+         RJ     ABNORML
-         LT     B0,ERROR-1
MSG1      DATA   48C SORT OR MERGE FLAG NOT 0 OR 1
          DATA   48C INPUT FILE COUNT ILLEGAL
          DATA   48C ILLEGAL NO. KEY FIELDS
          DATA   48C NEGATIVE OR MISSING RECORD LENGTH
          DATA   48C ILLEGAL PARITY ERROR OPTION
          DATA   48C SORTING ORDER NOT A OR D
          DATA   48C ILLEGAL KEY TYPE
          DATA   48C KEY POSTIION NOT SPECIFIED
          DATA   48C NO KEY LENGTH SPECIFIED
          DATA   48C ILLEGAL RECORD TYPE
          DATA   48C ILLEGAL DISPOSAL CODE
          DATA   48C ILLEGAL USE CODE
          DATA   48C FILE WAS NOT SPECIFIED IN SRTMRG CALL
          DATA   48C ILLEGAL TRAILER SPEC. FOR VARIABLE FIELD
          DATA   48C ILLEGAL LABEL TYPE
          DATA   48C ILLEGAL PARITY MODE
          DATA   48C ILLEGAL LABEL LENGTH
          END
      SUBROUTINE UNS (IC,IA,IDX,IDZ,IMS)                                 UNS
      IF (IC)   5,5,10                                                   UNS
    5 IMS=1                                                              UNS
      NC=-IC                                                             UNS
      GOTO 15                                                            UNS
   10 IMS=0                                                              UNS
      NC=IC                                                              UNS
   15 IF (NC-100)   20,25,25                                             UNS
   20 IA=0                                                               UNS
      GOTO 30                                                            UNS
   25 IA=1                                                               UNS
      NC=NC-100                                                          UNS
   30 IDX=NC/10                                                          UNS
      IDZ=NC-IDX*10                                                      UNS
      RETURN                                                             UNS
      END                                                                UNS
      SUBROUTINE DISSER (XA,TAB,I,NX,ID,NPX)                             DISSER
      DIMENSION TAB(2)                                                   DISSER
C     DIMENSION TAB(2)                                                   DISSER
      NPT=ID+1                                                           DISSER
      NPB=NPT/2                                                          DISSER
      NPU=NPT-NPB                                                        DISSER
      IF (NX-NPT)   10,5,10                                              DISSER
    5 NPX=I                                                              DISSER
      RETURN                                                             DISSER
   10 NLOW=I+NPB                                                         DISSER
      NUPP=I+NX-(NPU+1)                                                  DISSER
      DO 15 II=NLOW,NUPP                                                 DISSER
      NLOC=II                                                            DISSER
      IF (TAB(II)-XA)   15,20,20                                         DISSER
   15 CONTINUE                                                           DISSER
      NPX=NUPP-NPB+1                                                     DISSER
      RETURN                                                             DISSER
   20 NL=NLOC-NPB                                                        DISSER
      NU=NL+ID                                                           DISSER
      DO 25 JJ=NL,NU                                                     DISSER
      NDIS=JJ                                                            DISSER
      IF (TAB(JJ)-TAB(JJ+1))   25,30,25                                  DISSER
   25 CONTINUE                                                           DISSER
      NPX=NL                                                             DISSER
      RETURN                                                             DISSER
   30 IF (TAB(NDIS)-XA)   40,35,35                                       DISSER
   35 NPX=NDIS-ID                                                        DISSER
      RETURN                                                             DISSER
   40 NPX=NDIS+1                                                         DISSER
      RETURN                                                             DISSER
      END                                                                DISSER
      SUBROUTINE LAGRAN (XA,X,Y,N,ANS)                                   LAGRAN
      DIMENSION X(2),Y(2)                                                LAGRAN
C     DIMENSION X(2),Y(2)                                                LAGRAN
      SUM=0.0                                                            LAGRAN
      DO 3 I=1,N                                                         LAGRAN
      PROD=Y(I)                                                          LAGRAN
      DO 2 J=1,N                                                         LAGRAN
      A=X(I)-X(J)                                                        LAGRAN
      IF (A)   1,2,1                                                     LAGRAN
    1 B=(XA-X(J))/A                                                      LAGRAN
      PROD=PROD*B                                                        LAGRAN
    2 CONTINUE                                                           LAGRAN
    3 SUM=SUM+PROD                                                       LAGRAN
      ANS=SUM                                                            LAGRAN
      RETURN                                                             LAGRAN
      END                                                                LAGRAN
      FUNCTION ROUND (DIGIT)                                             ROUND
      DATA K/1/                                                          ROUND
      DATA II/12/                                                        ROUND
      IF (DIGIT) 5,40,5                                                  ROUND
    5 TRIAL = ABS(DIGIT)                                                 ROUND
      I = 0.4343*ALOG(TRIAL)+1.0                                         ROUND
      IF (I) 10,15,30                                                    ROUND
   10 I=0                                                                ROUND
   15 INTEGER = TRIAL*10.0**(I+K)                                        ROUND
      IF (INTEGER) 20,20,25                                              ROUND
   20 I = I+K                                                            ROUND
      GO TO 15                                                           ROUND
   25 I = -I                                                             ROUND
   30 J = I-II                                                           ROUND
      ROUND = DIGIT+(SIGN((1.0*10.0**J),DIGIT))                          ROUND
      GO TO 99                                                           ROUND
   40 ROUND = DIGIT                                                      ROUND
   99 RETURN                                                             ROUND
      END                                                                ROUND
      SUBROUTINE WHERE (X1,Y1,IC)                                        WHERE
C      THIS SUBROUTINE RETURNS THE CURRENT POSITION AND STATUS           WHERE
C      OF THE PEN. THE FIRST AND SECOND ARGUMENTS ARE THE POSITION.      WHERE
      COMMON /LANGLEY/ IFLTR,KINCR,IPDN,RETURNR,PENX,PENY,IEPE,IVIEW,NME WHERE
     1,IST,JST,KST,OFFSET,FRAME,NPG,IBAG,LUN,JTPWRI                      WHERE
     Z,IBA,DX,DY                                                         WHERE
      X1 = PENX                                                          WHERE
      Y1 = PENY                                                          WHERE
      IC = IEPE                                                          WHERE
      RETURN                                                             WHERE
      END                                                                WHERE
      SUBROUTINE NUMBER                                                 NUMBER
CNUMBER IS A PROPRIETARY ROUTINE WHICH IS DELIVERED WITH THE            NUMBER
C      CALCOMP PLOTTER......                                            NUMBER
      A=A                                                               NUMBER
      RETURN                                                            NUMBER
      END                                                               NUMBER
      SUBROUTINE CALCOMP                                                CALCOMP
C        CALCOMP IS A PROPRIETARY ROUTINE DELIVERED WITH THE            CALCOMP
C        CALCOMP PLOTTER . . . . . .                                    CALCOMP
      A=A                                                               CALCOMP
      RETURN                                                            CALCOMP
      END                                                               CALCOMP
      SUBROUTINE CALPLT                                                 CALPLT
C        CALPLT IS A PROPRIETARY ROUTINE DELIVERED WITH THE             CALPLT
C        CALCOMP PLOTTER . . . . . .                                    CALPLT
      A=A                                                               CALPLT
      RETURN                                                            CALPLT
      END                                                               CALPLT
      SUBROUTINE NOTATE                                                 NOTATE
C        NOTATE IS A PROPRIETARY ROUTINE DEILVERED WITH THE             NOTATE
C        CALCOMP PLOTTER . . . . . .                                    NOTATE
      A=A                                                               NOTATE
      RETURN                                                            NOTATE
      END                                                               NOTATE
